Clean up
This commit is contained in:
parent
e4a8fb2747
commit
7397a0fecd
3 changed files with 30 additions and 47 deletions
|
|
@ -1,13 +1,10 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Mima.Vm.Flags
|
module Mima.Vm.Flags
|
||||||
( Flags(..)
|
( Flags(..)
|
||||||
-- * Methods for interacting with 'Flags'
|
|
||||||
, readonlyAt
|
, readonlyAt
|
||||||
, executableAt
|
, executableAt
|
||||||
, breakpointAt
|
, breakpointAt
|
||||||
-- * Conversion methods for 'Metadata'
|
|
||||||
, flagsFromMetadata
|
, flagsFromMetadata
|
||||||
, sampleMeta
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Aeson.Types as A
|
import qualified Data.Aeson.Types as A
|
||||||
|
|
@ -15,13 +12,11 @@ import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Mima.Run
|
|
||||||
import Mima.Vm.Metadata
|
import Mima.Vm.Metadata
|
||||||
import Mima.Vm.Storage
|
|
||||||
import Mima.Vm.Word
|
import Mima.Vm.Word
|
||||||
|
|
||||||
-- | A collection of parsed flags in a more efficient representation than
|
-- | A collection of parsed flags in a more efficient representation than
|
||||||
-- 'Metadata'
|
-- 'Metadata'
|
||||||
data Flags = Flags
|
data Flags = Flags
|
||||||
{ flagReadonly :: Set.Set MimaAddress
|
{ flagReadonly :: Set.Set MimaAddress
|
||||||
, flagExecutable :: Set.Set MimaAddress
|
, flagExecutable :: Set.Set MimaAddress
|
||||||
|
|
@ -38,9 +33,8 @@ instance Monoid Flags where
|
||||||
readonlyAt :: Flags -> MimaAddress -> Bool
|
readonlyAt :: Flags -> MimaAddress -> Bool
|
||||||
readonlyAt flags address = Set.member address (flagReadonly flags)
|
readonlyAt flags address = Set.member address (flagReadonly flags)
|
||||||
|
|
||||||
-- | Checks if a given address has the "executable" flag set.
|
-- | Checks if a given address has the "executable" flag set. If the given
|
||||||
-- If the given 'Flags' has no 'flagExecutable', this method will
|
-- 'Flags' has no 'flagExecutable', this method will return 'True'.
|
||||||
-- return 'True'.
|
|
||||||
executableAt :: Flags -> MimaAddress -> Bool
|
executableAt :: Flags -> MimaAddress -> Bool
|
||||||
executableAt flags address
|
executableAt flags address
|
||||||
| Set.null set = True
|
| Set.null set = True
|
||||||
|
|
@ -52,7 +46,6 @@ executableAt flags address
|
||||||
breakpointAt :: Flags -> MimaAddress -> Bool
|
breakpointAt :: Flags -> MimaAddress -> Bool
|
||||||
breakpointAt flags address = Set.member address (flagBreakpoint flags)
|
breakpointAt flags address = Set.member address (flagBreakpoint flags)
|
||||||
|
|
||||||
|
|
||||||
{- Conversion from Metadata -}
|
{- Conversion from Metadata -}
|
||||||
|
|
||||||
flagsFromMetadata :: Metadata -> Flags
|
flagsFromMetadata :: Metadata -> Flags
|
||||||
|
|
@ -61,18 +54,9 @@ flagsFromMetadata metadata =
|
||||||
where
|
where
|
||||||
ranges = mdLocal metadata
|
ranges = mdLocal metadata
|
||||||
rangesToMap key = mconcat . reverse . map (rangeToMap key) $ ranges
|
rangesToMap key = mconcat . reverse . map (rangeToMap key) $ ranges
|
||||||
flagSet = Map.keysSet . Map.filter valueToBool . rangesToMap
|
flagSet = Map.keysSet . Map.filter (/= A.Bool False) . rangesToMap
|
||||||
|
|
||||||
rangeToMap :: T.Text -> Range -> Map.Map MimaAddress A.Value
|
rangeToMap :: T.Text -> Range -> Map.Map MimaAddress A.Value
|
||||||
rangeToMap key range = case getMetaInfo range Map.!? key of
|
rangeToMap key range = case getMetaInfo range Map.!? key of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
Just v -> Map.fromList $ zip (getAddresses range) (repeat v)
|
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
|
|
||||||
|
|
|
||||||
|
|
@ -3,8 +3,8 @@
|
||||||
module Mima.Vm.Metadata
|
module Mima.Vm.Metadata
|
||||||
( MetaInfo
|
( MetaInfo
|
||||||
, Range(..)
|
, Range(..)
|
||||||
, getMetaInfo
|
|
||||||
, getAddresses
|
, getAddresses
|
||||||
|
, getMetaInfo
|
||||||
, Metadata(..)
|
, Metadata(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
@ -25,7 +25,7 @@ data Range
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
getAddresses :: Range -> [MimaAddress]
|
getAddresses :: Range -> [MimaAddress]
|
||||||
getAddresses (RangeAt _ address) = [address]
|
getAddresses (RangeAt _ address) = [address]
|
||||||
getAddresses (RangeFromTo _ start stop) = [start..stop]
|
getAddresses (RangeFromTo _ start stop) = [start..stop]
|
||||||
|
|
||||||
getMetaInfo :: Range -> MetaInfo
|
getMetaInfo :: Range -> MetaInfo
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Mima.Vm.FlagSpec (spec) where
|
module Mima.Vm.FlagSpec (spec) where
|
||||||
|
|
||||||
import qualified Data.Aeson.Types as A
|
import qualified Data.Aeson.Types as A
|
||||||
|
|
@ -22,8 +23,7 @@ breakpointFlags addresses = Flags mempty mempty (Set.fromList addresses)
|
||||||
|
|
||||||
executableBetween :: Bool -> MimaAddress -> MimaAddress -> Metadata
|
executableBetween :: Bool -> MimaAddress -> MimaAddress -> Metadata
|
||||||
executableBetween executable start stop = Metadata mempty
|
executableBetween executable start stop = Metadata mempty
|
||||||
[
|
[ RangeFromTo (Map.singleton "executable" (A.Bool executable)) start stop
|
||||||
RangeFromTo (Map.fromList [("executable", A.Bool executable)]) start stop
|
|
||||||
]
|
]
|
||||||
|
|
||||||
overlappingExecutableFlags :: Flags
|
overlappingExecutableFlags :: Flags
|
||||||
|
|
@ -44,13 +44,13 @@ tripleOverlappingExecutableFlags = flags
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "readonly getter works" $
|
describe "readonlyAt" $
|
||||||
it "returns the correct set value" $ do
|
it "returns the correct set value" $ do
|
||||||
readonlyAt (readOnlyFlags [2, 5]) 2 `shouldBe` True
|
readonlyAt (readOnlyFlags [2, 5]) 2 `shouldBe` True
|
||||||
readonlyAt (readOnlyFlags [2, 5]) 5 `shouldBe` True
|
readonlyAt (readOnlyFlags [2, 5]) 5 `shouldBe` True
|
||||||
readonlyAt (readOnlyFlags [2, 5]) 3 `shouldBe` False
|
readonlyAt (readOnlyFlags [2, 5]) 3 `shouldBe` False
|
||||||
|
|
||||||
describe "execute getter works" $ do
|
describe "executeAt" $ do
|
||||||
it "returns the correct set value" $ do
|
it "returns the correct set value" $ do
|
||||||
executableAt (executeFlags [20, 200]) 2 `shouldBe` False
|
executableAt (executeFlags [20, 200]) 2 `shouldBe` False
|
||||||
executableAt (executeFlags [20, 200]) 20 `shouldBe` True
|
executableAt (executeFlags [20, 200]) 20 `shouldBe` True
|
||||||
|
|
@ -58,29 +58,28 @@ spec = do
|
||||||
it "returns true if none are set" $ property $ \x ->
|
it "returns true if none are set" $ property $ \x ->
|
||||||
let word = fromInteger x
|
let word = fromInteger x
|
||||||
in executableAt mempty word
|
in executableAt mempty word
|
||||||
|
context "with nested ranges" $ do
|
||||||
|
it "returns the correct value for unaffected areas" $ do
|
||||||
|
let flags = overlappingExecutableFlags
|
||||||
|
executableAt flags 1 `shouldBe` True
|
||||||
|
executableAt flags 3 `shouldBe` True
|
||||||
|
executableAt flags 7 `shouldBe` True
|
||||||
|
executableAt flags 20 `shouldBe` True
|
||||||
|
it "returns the correct value for affected areas" $ do
|
||||||
|
let flags = overlappingExecutableFlags
|
||||||
|
executableAt flags 4 `shouldBe` False
|
||||||
|
executableAt flags 5 `shouldBe` False
|
||||||
|
executableAt flags 6 `shouldBe` False
|
||||||
|
it "returns the correct value for triple affected areas" $ do
|
||||||
|
let flags = tripleOverlappingExecutableFlags
|
||||||
|
executableAt flags 1 `shouldBe` True
|
||||||
|
executableAt flags 4 `shouldBe` False
|
||||||
|
executableAt flags 5 `shouldBe` True
|
||||||
|
executableAt flags 6 `shouldBe` True
|
||||||
|
executableAt flags 20 `shouldBe` True
|
||||||
|
|
||||||
describe "breakpoint getter works" $
|
describe "breakpointAt" $
|
||||||
it "returns the correct set value" $ do
|
it "returns the correct set value" $ do
|
||||||
breakpointAt (breakpointFlags [20, 200]) 2 `shouldBe` False
|
breakpointAt (breakpointFlags [20, 200]) 2 `shouldBe` False
|
||||||
breakpointAt (breakpointFlags [20, 200]) 20 `shouldBe` True
|
breakpointAt (breakpointFlags [20, 200]) 20 `shouldBe` True
|
||||||
breakpointAt (breakpointFlags [20, 200]) 200 `shouldBe` True
|
breakpointAt (breakpointFlags [20, 200]) 200 `shouldBe` True
|
||||||
|
|
||||||
context "with nested ranges" $ do
|
|
||||||
it "returns the correct value for unaffected areas" $ do
|
|
||||||
let flags = overlappingExecutableFlags
|
|
||||||
executableAt flags 1 `shouldBe` True
|
|
||||||
executableAt flags 3 `shouldBe` True
|
|
||||||
executableAt flags 7 `shouldBe` True
|
|
||||||
executableAt flags 20 `shouldBe` True
|
|
||||||
it "returns the correct value for affected areas" $ do
|
|
||||||
let flags = overlappingExecutableFlags
|
|
||||||
executableAt flags 4 `shouldBe` False
|
|
||||||
executableAt flags 5 `shouldBe` False
|
|
||||||
executableAt flags 6 `shouldBe` False
|
|
||||||
it "returns the correct value for triple affected areas" $ do
|
|
||||||
let flags = tripleOverlappingExecutableFlags
|
|
||||||
executableAt flags 1 `shouldBe` True
|
|
||||||
executableAt flags 4 `shouldBe` False
|
|
||||||
executableAt flags 5 `shouldBe` True
|
|
||||||
executableAt flags 6 `shouldBe` True
|
|
||||||
executableAt flags 20 `shouldBe` True
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue