mima-tools/src/Mima/Load.hs
2019-11-08 18:33:08 +00:00

63 lines
1.7 KiB
Haskell

{-# LANGUAGE FlexibleInstances #-}
module Mima.Load
( loadStateFromFile
, saveStateToFile
) where
import Control.Applicative
import Control.Monad
import Data.Binary
import qualified Data.ByteString.Lazy as BS
import Mima.Word
import Mima.State
-- To prevent orphan instances and keep the compiler happy
newtype LD t = LD { unLD :: t }
instance Binary (LD MimaWord) where
put mw = do
let (w1, w2, w3) = wordToBytes $ unLD mw
forM_ [w1, w2, w3] put
get = do
bytes <- (,,) <$> get <*> get <*> get
pure $ LD $ bytesToWord bytes
instance Binary (LD LargeValue) where
put = put . LD . largeValueToWord . unLD
get = (LD . getLargeValue) <$> unLD <$> get
instance Binary (LD MimaMemory) where
put = mapM_ (put . LD) . memoryToWords . unLD
get = (LD . wordsToMemory . map unLD) <$> many get
instance Binary (LD MimaState) where
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
loadStateFromFile :: FilePath -> IO (Either String MimaState)
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"
saveStateToFile :: FilePath -> MimaState -> IO ()
saveStateToFile path = BS.writeFile path . encode . LD