Introduce Run monad

A monad for nice, pure exceptions. I want to avoid working with IO
exceptions as much as possible.
This commit is contained in:
Joscha 2019-11-13 09:28:53 +00:00
parent 1b8680004e
commit b554d80aa9
4 changed files with 96 additions and 61 deletions

View file

@ -1,17 +1,32 @@
module Mima.IO
( parseFile
( Run
, doRun
, failWith
, parseFile
) where
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import qualified Data.Text.IO as T
import Text.Megaparsec
import Mima.Parser.Common
parseFile :: Parser a -> FilePath -> IO (Maybe a)
type Run a = ExceptT String IO a
doRun :: Run () -> IO ()
doRun r = do
result <- runExceptT r
case result of
Left errorMsg -> putStrLn errorMsg
Right () -> pure ()
failWith :: String -> Run a
failWith = except . Left
parseFile :: Parser a -> FilePath -> Run a
parseFile parser filepath = do
content <- T.readFile filepath
content <- lift $ T.readFile filepath
case parse parser filepath content of
Right a -> pure $ Just a
Left errorBundle -> do
putStrLn $ errorBundlePretty errorBundle
pure Nothing
Right a -> pure a
Left errorBundle -> failWith $ errorBundlePretty errorBundle

View file

@ -7,11 +7,13 @@ module Mima.Load
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Data.Binary
import qualified Data.ByteString.Lazy as BS
import Mima.Word
import Mima.IO
import Mima.State
import Mima.Word
-- To prevent orphan instances and keep the compiler happy
newtype LD t = LD { unLD :: t }
@ -50,14 +52,14 @@ instance Binary (LD MimaState) where
mem <- unLD <$> get
pure $ LD $ MimaState iar acc ra sp fp mem
loadStateFromFile :: FilePath -> IO (Either String MimaState)
loadStateFromFile :: FilePath -> Run MimaState
loadStateFromFile path = do
bs <- BS.readFile path
pure $ case decodeOrFail bs of
Left ( _, _, e) -> Left e
bs <- lift $ BS.readFile path
case decodeOrFail bs of
Left ( _, _, e) -> failWith e
Right (bs', _, ldms)
| BS.null bs' -> Right $ unLD ldms
| otherwise -> Left "Input was not consumed fully"
| BS.null bs' -> pure $ unLD ldms
| otherwise -> failWith "Input was not consumed fully"
saveStateToFile :: FilePath -> MimaState -> IO ()
saveStateToFile path = BS.writeFile path . encode . LD
saveStateToFile :: FilePath -> MimaState -> Run ()
saveStateToFile path = lift . BS.writeFile path . encode . LD