Garmelon/mima-tools
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Parse ranges in meta file

Browse source
This commit is contained in:
I-Al-Istannen 2020-03-25 23:26:10 +01:00
parent 70189144f1
commit 737c04a741
1 changed files with 26 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/Mima/Vm/MetaFileParser.hs
View file

@ -7,14 +7,18 @@ module Mima.Vm.MetaFileParser
, LocalData , LocalData
) where ) where
import Control.Applicative
import Data.Aeson import Data.Aeson
import Data.Aeson.Types import Data.Aeson.Types
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import Data.Traversable import Data.Traversable
import Mima.Vm.Word
import Numeric import Numeric
import Text.ParserCombinators.ReadP
import Mima.Format
import Mima.Vm.Word
data Metadata = Metadata data Metadata = Metadata
{ global :: GlobalData { global :: GlobalData
@ -39,22 +43,29 @@ instance ToJSON Metadata where
parseLocalData :: Value -> Parser LocalData parseLocalData :: Value -> Parser LocalData
parseLocalData = withObject "local" $ \obj -> do parseLocalData = withObject "local" $ \obj -> do
v <- for (HM.toList obj) unpackInner v <- for (HM.toList obj) unpackInner
return $ Map.fromList v return $ Map.fromList (concat v)
where where
unpackInner (key, nestedValue) = do unpackInner (key, nestedValue) = do
address <- readMimaAddress (T.unpack key) (start, end) <- readMimaAddress (T.unpack key)
innerValues <- parseJSON nestedValue innerValues <- parseJSON nestedValue
return (address, innerValues) return $ zip [start..end] (repeat innerValues)
readMimaAddress :: String -> Parser MimaAddress readMimaAddress :: String -> Parser (MimaAddress, MimaAddress)
readMimaAddress input = case readHex input of readMimaAddress input = case readP_to_S readFromHex input of
[(num, "")] -> boundedAddress input num [(addresses, [])] -> pure addresses
_ -> fail $ "Couldn't read " ++ input ++ "' as a mima address!" xs -> fail $ "'" ++ input ++ "' is no address, " ++ show xs
boundedAddress :: String -> Integer -> Parser MimaAddress readFromHex :: ReadP (MimaAddress,MimaAddress)
boundedAddress rawInput value = readFromHex = (range <|> single) <* eof
where
range = (,) <$> (boundedAddress <* char '-') <*> boundedAddress
single = (\x -> (x, x)) <$> boundedAddress
boundedAddress :: ReadP MimaAddress
boundedAddress = do
value <- readS_to_P readHex :: ReadP Integer
if value > maxVal || value < minVal then if value > maxVal || value < minVal then
fail $ "Value '" ++ rawInput ++ "' out of bounds for an address." fail $ T.unpack $ "Value '" <> toHex value <> "' out of bounds for an address."
else else
pure $ fromIntegral value pure $ fromIntegral value
where where
@ -64,4 +75,4 @@ boundedAddress rawInput value =
localDataToJson :: LocalData -> Value localDataToJson :: LocalData -> Value
localDataToJson outerMap = object $ map formatInnerEntry (Map.toList outerMap) localDataToJson outerMap = object $ map formatInnerEntry (Map.toList outerMap)
where where
formatInnerEntry (address, innerMap) = T.pack (showHex address "") .= toJSON innerMap formatInnerEntry (address, innerMap) = fixWidthHex 5 (toHex address) .= toJSON innerMap