From 70189144f1c115a1f7a562762f7f951e4f021e34 Mon Sep 17 00:00:00 2001
From: I-Al-Istannen <i-al-istannen@users.noreply.github.com>
Date: Wed, 25 Mar 2020 22:46:24 +0100
Subject: [PATCH] Add a primitive meta file parser

---
 package.yaml                  |  2 ++
 src/Mima/Vm/MetaFileParser.hs | 67 +++++++++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+)
 create mode 100644 src/Mima/Vm/MetaFileParser.hs

diff --git a/package.yaml b/package.yaml
index a1be346..3956c4c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -16,6 +16,8 @@ dependencies:
   - OddWord >= 1.0 && < 1.1
   - containers
   - text
+  - aeson
+  - unordered-containers
 
 library:
   source-dirs: src
diff --git a/src/Mima/Vm/MetaFileParser.hs b/src/Mima/Vm/MetaFileParser.hs
new file mode 100644
index 0000000..5684498
--- /dev/null
+++ b/src/Mima/Vm/MetaFileParser.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Mima.Vm.MetaFileParser
+  ( Metadata(..)
+  , GlobalData
+  , LocalData
+  ) where
+
+import           Data.Aeson
+import           Data.Aeson.Types
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict     as Map
+import qualified Data.Text           as T
+import           Data.Traversable
+import           Mima.Vm.Word
+import           Numeric
+
+data Metadata = Metadata
+ { global :: GlobalData
+ , local  :: LocalData
+ } deriving Show
+
+type GlobalData = Map.Map T.Text Value
+type LocalData = Map.Map MimaAddress (Map.Map T.Text Value)
+
+instance FromJSON Metadata where
+  parseJSON = withObject "root" $ \obj -> do
+    globalData <- obj .: "global"
+    localData <- parseLocalData =<< obj .: "local"
+    return $ Metadata globalData localData
+
+instance ToJSON Metadata where
+  toJSON Metadata{local, global} = object
+   [ "global" .= toJSON global
+   , "local" .= toJSON (localDataToJson local)
+   ]
+
+parseLocalData :: Value -> Parser LocalData
+parseLocalData = withObject "local" $ \obj -> do
+  v <- for (HM.toList obj) unpackInner
+  return $ Map.fromList v
+  where
+    unpackInner (key, nestedValue) = do
+      address <- readMimaAddress (T.unpack key)
+      innerValues <- parseJSON nestedValue
+      return (address, innerValues)
+
+readMimaAddress :: String -> Parser MimaAddress
+readMimaAddress input = case readHex input of
+  [(num, "")] -> boundedAddress input num
+  _           -> fail $ "Couldn't read " ++ input ++ "' as a mima address!"
+
+boundedAddress :: String -> Integer -> Parser MimaAddress
+boundedAddress rawInput value =
+  if value > maxVal || value < minVal then
+    fail $ "Value '" ++ rawInput ++ "' out of bounds for an address."
+  else
+    pure $ fromIntegral value
+  where
+    maxVal = fromIntegral (maxBound :: MimaAddress)
+    minVal = fromIntegral (minBound :: MimaAddress)
+
+localDataToJson :: LocalData -> Value
+localDataToJson outerMap = object $ map formatInnerEntry (Map.toList outerMap)
+  where
+    formatInnerEntry (address, innerMap) = T.pack (showHex address "") .= toJSON innerMap