Add flag data structure and conversion
This commit is contained in:
parent
69983fc9ed
commit
caf9a896d8
3 changed files with 107 additions and 0 deletions
78
src/Mima/Vm/Flags.hs
Normal file
78
src/Mima/Vm/Flags.hs
Normal file
|
|
@ -0,0 +1,78 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module Mima.Vm.Flags
|
||||||
|
( Flags(..)
|
||||||
|
-- * Methods for interacting with 'Flags'
|
||||||
|
, readonlyAt
|
||||||
|
, executableAt
|
||||||
|
, breakpointAt
|
||||||
|
-- * Conversion methods for 'Metadata'
|
||||||
|
, flagsFromMetadata
|
||||||
|
, sampleMeta
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.Aeson.Types as A
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
import Mima.Run
|
||||||
|
import Mima.Vm.Metadata
|
||||||
|
import Mima.Vm.Storage
|
||||||
|
import Mima.Vm.Word
|
||||||
|
|
||||||
|
-- | A collection of parsed flags in a more efficient representation than
|
||||||
|
-- 'Metadata'
|
||||||
|
data Flags = Flags
|
||||||
|
{ flagReadonly :: Set.Set MimaAddress
|
||||||
|
, flagExecutable :: Set.Set MimaAddress
|
||||||
|
, flagBreakpoint :: Set.Set MimaAddress
|
||||||
|
} deriving Show
|
||||||
|
|
||||||
|
instance Semigroup Flags where
|
||||||
|
(Flags a1 b1 c1) <> (Flags a2 b2 c2) = Flags (a1 <> a2) (b1 <> b2) (c1 <> c2)
|
||||||
|
|
||||||
|
instance Monoid Flags where
|
||||||
|
mempty = Flags mempty mempty mempty
|
||||||
|
|
||||||
|
-- | Checks if a given address has the "readonly" flag set.
|
||||||
|
readonlyAt :: Flags -> MimaAddress -> Bool
|
||||||
|
readonlyAt flags address = Set.member address (flagReadonly flags)
|
||||||
|
|
||||||
|
-- | Checks if a given address has the "executable" flag set.
|
||||||
|
-- If the given 'Flags' has no 'flagExecutable', this method will
|
||||||
|
-- return 'True'.
|
||||||
|
executableAt :: Flags -> MimaAddress -> Bool
|
||||||
|
executableAt flags address
|
||||||
|
| Set.null set = True
|
||||||
|
| otherwise = Set.member address set
|
||||||
|
where
|
||||||
|
set = flagExecutable flags
|
||||||
|
|
||||||
|
-- | Checks if a given address has a the "breakpoint" flag set.
|
||||||
|
breakpointAt :: Flags -> MimaAddress -> Bool
|
||||||
|
breakpointAt flags address = Set.member address (flagBreakpoint flags)
|
||||||
|
|
||||||
|
|
||||||
|
{- Conversion from Metadata -}
|
||||||
|
|
||||||
|
flagsFromMetadata :: Metadata -> Flags
|
||||||
|
flagsFromMetadata metadata =
|
||||||
|
Flags (flagSet "readonly") (flagSet "executable") (flagSet "breakpoint")
|
||||||
|
where
|
||||||
|
ranges = mdLocal metadata
|
||||||
|
rangesToMap key = mconcat . map (rangeToMap key) $ ranges
|
||||||
|
flagSet = Map.keysSet . Map.filter valueToBool . rangesToMap
|
||||||
|
|
||||||
|
rangeToMap :: T.Text -> Range -> Map.Map MimaAddress A.Value
|
||||||
|
rangeToMap key range = case getMetaInfo range Map.!? key of
|
||||||
|
Nothing -> mempty
|
||||||
|
Just v -> Map.fromList $ zip (getAddresses range) (repeat v)
|
||||||
|
|
||||||
|
valueToBool :: A.Value -> Bool
|
||||||
|
valueToBool (A.Bool False) = False
|
||||||
|
valueToBool _ = True
|
||||||
|
|
||||||
|
sampleMeta :: Run Flags
|
||||||
|
sampleMeta = do
|
||||||
|
m <- loadMetadata "test/files/FlaggyMetadataFile.json"
|
||||||
|
pure $ flagsFromMetadata m
|
||||||
|
|
@ -4,6 +4,7 @@ module Mima.Vm.Metadata
|
||||||
( MetaInfo
|
( MetaInfo
|
||||||
, Range(..)
|
, Range(..)
|
||||||
, getMetaInfo
|
, getMetaInfo
|
||||||
|
, getAddresses
|
||||||
, Metadata(..)
|
, Metadata(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
@ -23,6 +24,10 @@ data Range
|
||||||
| RangeFromTo MetaInfo MimaAddress MimaAddress
|
| RangeFromTo MetaInfo MimaAddress MimaAddress
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
getAddresses :: Range -> [MimaAddress]
|
||||||
|
getAddresses (RangeAt _ address) = [address]
|
||||||
|
getAddresses (RangeFromTo _ start stop) = [start..stop]
|
||||||
|
|
||||||
getMetaInfo :: Range -> MetaInfo
|
getMetaInfo :: Range -> MetaInfo
|
||||||
getMetaInfo (RangeAt info _) = info
|
getMetaInfo (RangeAt info _) = info
|
||||||
getMetaInfo (RangeFromTo info _ _) = info
|
getMetaInfo (RangeFromTo info _ _) = info
|
||||||
|
|
|
||||||
24
test/files/FlaggyMetadataFile.json
Normal file
24
test/files/FlaggyMetadataFile.json
Normal file
|
|
@ -0,0 +1,24 @@
|
||||||
|
{
|
||||||
|
"global": {
|
||||||
|
"some-data": "some value"
|
||||||
|
},
|
||||||
|
"local": [
|
||||||
|
{
|
||||||
|
"at": 20,
|
||||||
|
"info": {
|
||||||
|
"breakpoint": true,
|
||||||
|
"readonly": true,
|
||||||
|
"executable": "probably"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"start": 1,
|
||||||
|
"stop": 5,
|
||||||
|
"info": {
|
||||||
|
"breakpoint": false,
|
||||||
|
"readonly": true,
|
||||||
|
"executable": "yes"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
||||||
Loading…
Add table
Add a link
Reference in a new issue