Clean up storage implementation

Also switch to lazy byte strings in Mima.Run because they appear to be used in
all libraries used.

src/Mima/Run.hs

@@ -17,7 +17,7 @@ module Mima.Run
 
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Except
-import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Lazy       as BS
 import qualified Data.Text                  as T
 import qualified Data.Text.IO               as T
 import           System.IO.Error

src/Mima/Vm/State.hs

@@ -10,7 +10,10 @@ module Mima.Vm.State
   , runN
   ) where
 
+import           Control.Applicative
+import           Data.Binary
 import           Data.Bits
+import           Data.Foldable
 import qualified Data.Text           as T
 
 import           Mima.Format
@@ -27,6 +30,47 @@ data MimaState = MimaState
   , msMemory :: !MimaMemory
   } deriving (Show)
 
+putWord :: MimaWord -> Put
+putWord w = putList [b1, b2, b3]
+  where
+    (b1, b2, b3) = wordToBytes w
+
+putAddress :: MimaAddress -> Put
+putAddress = putWord . largeValueToWord
+
+putMemory :: MimaMemory -> Put
+putMemory = traverse_ putWord . memoryToWords
+
+getWord :: Get MimaWord
+getWord = do
+  b1 <- get
+  b2 <- get
+  b3 <- get
+  pure $ bytesToWord (b1, b2, b3)
+
+getAddress :: Get MimaAddress
+getAddress = getLargeValue <$> getWord
+
+getMemory :: Get MimaMemory
+getMemory = wordsToMemory <$> many getWord
+
+instance Binary MimaState where
+  put ms = do
+    putAddress $ msIar ms
+    putWord $ msAcc ms
+    putAddress $ msRa ms
+    putAddress $ msSp ms
+    putAddress $ msFp ms
+    putMemory $ msMemory ms
+
+  get = MimaState
+    <$> getAddress
+    <*> getWord
+    <*> getAddress
+    <*> getAddress
+    <*> getAddress
+    <*> getMemory
+
 basicState :: MimaMemory -> MimaState
 basicState = MimaState zeroBits zeroBits zeroBits zeroBits zeroBits
 

src/Mima/Vm/Storage.hs

@@ -1,78 +1,40 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Mima.Vm.Storage
-  (
-  -- * Methods for loading/storing 'Metadata'
-    loadMetadata
+  ( loadMetadata
   , saveMetadata
+  , loadMimaState
   , saveMimaState
-  -- * Test methods
-  , roundTripFile
-  , saveInterestingState
   ) where
 
-import           Data.Aeson
-import           Data.Aeson.Encode.Pretty
-import qualified Data.ByteString.Lazy     as BSL
-import qualified Data.Map.Strict          as Map
+import qualified Data.Aeson               as A
+import qualified Data.Aeson.Encode.Pretty as A
+import qualified Data.Binary              as B
 import qualified Data.Text                as T
+
 import           Mima.Run
-import           Mima.Vm.Memory
 import           Mima.Vm.Metadata
 import           Mima.Vm.State
-import           Mima.Vm.Word
 
 -- | Loads 'Metadata' from a given file path.
 loadMetadata :: FilePath -> Run Metadata
 loadMetadata path = do
   file <- readFileBS path
-  case eitherDecode $ BSL.fromStrict file of
-    Left msg       -> throw (T.pack msg)
+  case A.eitherDecode file of
+    Left msg       -> throw $ T.pack msg
     Right metadata -> pure metadata
 
 -- | Stores prettified 'Metadata' in a given file.
 saveMetadata :: FilePath -> Metadata -> Run ()
-saveMetadata path metadata = writeFileBS path (BSL.toStrict (encodePretty metadata))
+saveMetadata path = writeFileBS path . A.encodePretty
+
+loadMimaState :: FilePath -> Run MimaState
+loadMimaState path = do
+  bs <- readFileBS path
+  case B.decodeOrFail bs of
+    Right ("", 0, a) -> pure a
+    Right _          -> throw "invalid file format"
+    Left (_, _, e)   -> throw $ T.pack e
 
 saveMimaState :: FilePath -> MimaState -> Run ()
-saveMimaState path state = do
-  let stateBS = saveMimaSateBS state
-  writeFileBS path (BSL.toStrict stateBS)
-
-saveMimaSateBS :: MimaState -> BSL.ByteString
-saveMimaSateBS state = mimaRegistersToBS state <> mimaMemoryToBS (msMemory state)
-
-mimaRegistersToBS :: MimaState -> BSL.ByteString
-mimaRegistersToBS MimaState{..}
-  =  mimaWordToBS (largeValueToWord msIar)
-  <> mimaWordToBS                   msAcc
-  <> mimaWordToBS (largeValueToWord msRa)
-  <> mimaWordToBS (largeValueToWord msSp)
-  <> mimaWordToBS (largeValueToWord msFp)
-
-mimaMemoryToBS :: MimaMemory -> BSL.ByteString
-mimaMemoryToBS memory = foldl appendWord mempty (memoryToWords memory)
-  where
-    appendWord string word = string <> mimaWordToBS word
-
-mimaWordToBS :: MimaWord -> BSL.ByteString
-mimaWordToBS = BSL.pack . tripleToList . wordToBytes
-  where
-    tripleToList (a, b, c) = [a, b, c]
-
--- | A garbage test method that resds the input file, parses it and writes the
---   prettified result back in the output file.
---
--- Can be used with the example file:
---
--- > roundTripFile "test/files/SimpleMetadataFile.json" "/tmp/test.json"
-roundTripFile :: FilePath -- ^ The input file
-              -> FilePath -- ^ The output file
-              -> Run ()
-roundTripFile input output = loadMetadata input >>= saveMetadata output
-
-saveInterestingState :: FilePath -> Run ()
-saveInterestingState path = saveMimaState path withRegisters
-  where
-    state = basicState $ mapToMemory $ Map.fromList $ zip [1..100] [1..100]
-    withRegisters = state{msIar = 5, msAcc = -2, msRa = 46565, msSp = 20}
+saveMimaState path = writeFileBS path . B.encode