Load and save specification file format

app/MimaRun.hs

@@ -186,17 +186,18 @@ main = do
   settings <- execParser opts
 
   putStrLn $ "Loading memdump at " ++ infile settings
-  mem <- loadMemoryFromFile (infile settings)
+  ms <- loadStateFromFile (infile settings)
+  case ms of
+    Left errorMsg -> putStrLn errorMsg
+    Right s       -> do
+      s' <- if norun settings then pure s else runMima settings s
 
-  let s = initialState mem
+      unless (quiet settings) $ do
-  s' <- if norun settings then pure s else runMima settings s
+        putStrLn ""
+        putStrLn "Dump of MiMa state:"
+        printStateLn (sparse settings) s'
+        putStrLn ""
 
-  unless (quiet settings) $ do
+      forM_ (memoryDump settings) $ \path -> do
-    putStrLn ""
+        putStrLn $ "Saving memdump at " ++ path
-    putStrLn "Dump of MiMa state:"
+        saveStateToFile path s'
-    printStateLn (sparse settings) s'
-    putStrLn ""
-
-  forM_ (memoryDump settings) $ \path -> do
-    putStrLn $ "Saving memdump at " ++ path
-    saveMemoryToFile path $ msMemory s'

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/Garm
 dependencies:
 - base                 >= 4.7    && < 5
 - ansi-terminal        >= 0.9.1  && < 0.10
+- binary               >= 0.8.6  && < 0.9
 - bytestring           >= 0.10.8 && < 0.11
 - containers           >= 0.6.0  && < 0.7
 - optparse-applicative >= 0.14.3 && < 0.15

src/Mima/Load.hs

@@ -1,39 +1,66 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 module Mima.Load
-  ( loadMemoryFromFile
+  ( loadStateFromFile
-  , saveMemoryToFile
+  , saveStateToFile
   ) where
 
-import           Data.Bits
+import           Control.Applicative
-import qualified Data.ByteString as BS
+import           Data.Binary
-import           Data.Word
+import qualified Data.ByteString.Lazy as BS
 
 import           Mima.Word
 import           Mima.State
 
--- These two functions are implemented with explicit recursion. The
+-- To prevent orphan instances and keep the compiler happy
--- first because it was easier to write that way, and the second in
+newtype LD t = LD { unLD :: t }
--- the hopes of better performance regarding list concatenation.
 
-bytesToWords :: [Word8] -> [MimaWord]
+instance Binary (LD (WB MimaWord_)) where
-bytesToWords (w1:w2:w3:ws) =  bytesToWord w1 w2 w3 : bytesToWords ws
+  put mw = do
-bytesToWords [w1,w2]       = [bytesToWord w1 w2       zeroBits]
+    let (w1, w2, w3) = wordToBytes $ unLD mw
-bytesToWords [w1]          = [bytesToWord w1 zeroBits zeroBits]
+    put w1
-bytesToWords []            = []
+    put w2
+    put w3
+  get = do
+    w1 <- get
+    w2 <- get
+    w3 <- get
+    pure $ LD $ bytesToWord w1 w2 w3
 
-wordsToBytes :: [MimaWord] -> [Word8]
+instance Binary (LD (WB LargeValue_)) where
-wordsToBytes []     = []
+  put = put . LD . largeValueToWord . unLD
-wordsToBytes (w:ws) =
+  get = (LD . getLargeValue) <$> unLD <$> get
-  let (w1, w2, w3) = wordToBytes w
-  in  w1 : w2 : w3 : wordsToBytes ws
 
-bsToWords :: BS.ByteString -> [MimaWord]
+instance Binary (LD MimaMemory) where
-bsToWords = bytesToWords . BS.unpack
+  put = mapM_ (put . LD) . memoryToWords . unLD
+  get = (LD . wordsToMemory . map unLD) <$> many get
 
-wordsToBs :: [MimaWord] -> BS.ByteString
+instance Binary (LD MimaState) where
-wordsToBs = BS.pack . wordsToBytes
+  put ldms = do
+    let ms = unLD ldms
+    put $ LD $ msIAR ms
+    put $ LD $ msACC ms
+    put $ LD $ msRA ms
+    put $ LD $ msSP ms
+    put $ LD $ msFP ms
+    put $ LD $ msMemory ms
+  get = do
+    iar <- unLD <$> get
+    acc <- unLD <$> get
+    ra  <- unLD <$> get
+    sp  <- unLD <$> get
+    fp  <- unLD <$> get
+    mem <- unLD <$> get
+    pure $ LD $ MimaState iar acc ra sp fp mem
 
-loadMemoryFromFile :: FilePath -> IO MimaMemory
+loadStateFromFile :: FilePath -> IO (Either String MimaState)
-loadMemoryFromFile path = (wordsToMemory . bsToWords) <$> BS.readFile path
+loadStateFromFile path = do
+  bs <- BS.readFile path
+  pure $ case decodeOrFail bs of
+    Left  (  _, _, e) -> Left e
+    Right (bs', _, ldms)
+      | BS.null bs' -> Right $ unLD ldms
+      | otherwise   -> Left "Input was not consumed fully"
 
-saveMemoryToFile :: FilePath -> MimaMemory -> IO ()
+saveStateToFile :: FilePath -> MimaState -> IO ()
-saveMemoryToFile path = BS.writeFile path . wordsToBs . memoryToWords
+saveStateToFile path = BS.writeFile path . encode . LD

src/Mima/Word.hs

@@ -29,6 +29,11 @@ module Mima.Word
   , SmallValue
   -- ** Converting
   , signedSmallValueToWord
+  -- * Underlying types
+  , WB
+  , MimaWord_
+  , LargeValue_
+  , SmallValue_
   ) where
 
 import           Data.Bits