diff --git a/mima-run/Main.hs b/mima-run/Main.hs index b98fa8b..5795cac 100644 --- a/mima-run/Main.hs +++ b/mima-run/Main.hs @@ -1,10 +1,31 @@ module Main where -import Options.Applicative +import Control.Monad.IO.Class +import qualified Data.Text.IO as T +import Options.Applicative -import Mima.MimaRun.Options +import Mima.Format +import Mima.MimaRun.Options +import Mima.Run +import Mima.Vm.State +import Mima.Vm.Storage main :: IO () -main = do - opts <- execParser parserInfo - putStrLn $ "The options are: " ++ show opts +main = runOrExit 2 $ do + opts <- liftIO $ execParser parserInfo + initialState <- loadMimaState $ inputFile opts + finalState <- liftIO $ case steps opts of + Nothing -> do + let (finalState, abortReason, stepsMade) = execute initialState + putStrLn $ "Stopped after " ++ show stepsMade ++ " steps, reason:" + T.putStrLn $ toText abortReason + pure finalState + Just n -> do + let (finalState, mAbortReason, stepsMade) = executeN n initialState + putStrLn $ "Stopped after " ++ show stepsMade ++ " steps, reason:" + case mAbortReason of + Nothing -> putStrLn "Ran out of steps" + Just abortReason -> T.putStrLn $ toText abortReason + pure finalState + liftIO $ putStrLn "" + liftIO $ print finalState diff --git a/mima-run/Mima/MimaRun/Options.hs b/mima-run/Mima/MimaRun/Options.hs index 70d1ba4..658a54e 100644 --- a/mima-run/Mima/MimaRun/Options.hs +++ b/mima-run/Mima/MimaRun/Options.hs @@ -3,16 +3,16 @@ module Mima.MimaRun.Options , parserInfo ) where -import Options.Applicative +import Options.Applicative data Options = Options { inputFile :: FilePath - , steps :: Maybe Integer + , steps :: Maybe Integer } deriving (Show) parser :: Parser Options parser = Options - <$> strOption + <$> strArgument ( help "The .mima file to use" <> metavar "INPUTFILE" ) diff --git a/src/Mima/Run.hs b/src/Mima/Run.hs index ba1cfb4..e184c1b 100644 --- a/src/Mima/Run.hs +++ b/src/Mima/Run.hs @@ -5,6 +5,7 @@ module Mima.Run -- * The 'Run' monad Run , run + , runOrExit , throw , catch , handle @@ -18,8 +19,10 @@ module Mima.Run import Control.Monad.IO.Class import Control.Monad.Trans.Except import qualified Data.ByteString.Lazy as BS +import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T +import System.Exit import System.IO.Error newtype Run a = Run (ExceptT T.Text IO a) @@ -28,6 +31,16 @@ newtype Run a = Run (ExceptT T.Text IO a) run :: Run a -> IO (Either T.Text a) run (Run e) = runExceptT e +runOrExit :: Int -> Run () -> IO () +runOrExit exitCode r = do + result <- run r + case result of + Right () -> pure () + Left e -> do + putStrLn "Encountered an exception:" + T.putStrLn e + exitWith $ ExitFailure exitCode + throw :: T.Text -> Run a throw = Run . throwE @@ -43,8 +56,10 @@ isRelevantError e = isAlreadyInUseError e || isDoesNotExistError e || isPermissi formatRelevantError :: IOError -> Maybe T.Text formatRelevantError e | isRelevantError e = Just $ T.pack $ - "Can't open file " <> ioeGetLocation e <> ": " <> ioeGetErrorString e + "Can't open file " <> fileName <> ": " <> ioeGetErrorString e | otherwise = Nothing + where + fileName = fromMaybe "" $ ioeGetFileName e protect :: IO a -> Run a protect m = do diff --git a/src/Mima/Vm/State.hs b/src/Mima/Vm/State.hs index da717ae..dedf0a6 100644 --- a/src/Mima/Vm/State.hs +++ b/src/Mima/Vm/State.hs @@ -6,8 +6,8 @@ module Mima.Vm.State , basicState , AbortReason(..) , step - , run - , runN + , execute + , executeN ) where import Control.Applicative @@ -157,16 +157,16 @@ step ms = do (SmallInstruction so lv) -> doSmallOpcode so lv ms' (LargeInstruction lo sv) -> doLargeOpcode lo sv ms' -run :: MimaState -> (MimaState, AbortReason, Integer) -run = helper 0 +execute :: MimaState -> (MimaState, AbortReason, Integer) +execute = helper 0 where helper completed s = case step s of Left e -> (s, e, completed) Right s' -> helper (completed + 1) s' -runN :: Integer -> MimaState -> (MimaState, Maybe AbortReason, Integer) -runN n = helper 0 +executeN :: Integer -> MimaState -> (MimaState, Maybe AbortReason, Integer) +executeN n = helper 0 where helper completed s = if completed >= n diff --git a/src/Mima/Vm/Storage.hs b/src/Mima/Vm/Storage.hs index b4fda91..f857306 100644 --- a/src/Mima/Vm/Storage.hs +++ b/src/Mima/Vm/Storage.hs @@ -32,7 +32,7 @@ loadMimaState :: FilePath -> Run MimaState loadMimaState path = do bs <- readFileBS path case B.decodeOrFail bs of - Right ("", 0, a) -> pure a + Right ("", _, a) -> pure a Right _ -> throw "invalid file format" Left (_, _, e) -> throw $ T.pack e