From caf9a896d8645a72ad9fc08c20ec2bc025c3456e Mon Sep 17 00:00:00 2001
From: I-Al-Istannen <i-al-istannen@users.noreply.github.com>
Date: Sat, 28 Mar 2020 17:46:41 +0100
Subject: [PATCH] Add flag data structure and conversion

---
 src/Mima/Vm/Flags.hs               | 78 ++++++++++++++++++++++++++++++
 src/Mima/Vm/Metadata.hs            |  5 ++
 test/files/FlaggyMetadataFile.json | 24 +++++++++
 3 files changed, 107 insertions(+)
 create mode 100644 src/Mima/Vm/Flags.hs
 create mode 100644 test/files/FlaggyMetadataFile.json

diff --git a/src/Mima/Vm/Flags.hs b/src/Mima/Vm/Flags.hs
new file mode 100644
index 0000000..b60f650
--- /dev/null
+++ b/src/Mima/Vm/Flags.hs
@@ -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
diff --git a/src/Mima/Vm/Metadata.hs b/src/Mima/Vm/Metadata.hs
index b51bcbe..c3a8248 100644
--- a/src/Mima/Vm/Metadata.hs
+++ b/src/Mima/Vm/Metadata.hs
@@ -4,6 +4,7 @@ module Mima.Vm.Metadata
   ( MetaInfo
   , Range(..)
   , getMetaInfo
+  , getAddresses
   , Metadata(..)
   ) where
 
@@ -23,6 +24,10 @@ data Range
   | RangeFromTo MetaInfo MimaAddress MimaAddress
   deriving Show
 
+getAddresses :: Range -> [MimaAddress]
+getAddresses (RangeAt _ address)        = [address]
+getAddresses (RangeFromTo _ start stop) = [start..stop]
+
 getMetaInfo :: Range -> MetaInfo
 getMetaInfo (RangeAt     info _)   = info
 getMetaInfo (RangeFromTo info _ _) = info
diff --git a/test/files/FlaggyMetadataFile.json b/test/files/FlaggyMetadataFile.json
new file mode 100644
index 0000000..08250f1
--- /dev/null
+++ b/test/files/FlaggyMetadataFile.json
@@ -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"
+      }
+    }
+  ]
+}