diff --git a/app/MimaAsm/Main.hs b/app/MimaAsm/Main.hs index dab0bc1..3f5e81d 100644 --- a/app/MimaAsm/Main.hs +++ b/app/MimaAsm/Main.hs @@ -33,7 +33,7 @@ main = doRun_ $ do settings <- lift $ execParser opts lift $ putStrLn $ "Loading assembly file at " ++ infile settings - (state, _, _) <- loadFile' readAssembly (infile settings) + (state, _, _) <- loadFile readAssembly (infile settings) lift $ putStrLn "Parsing successful" lift $ putStrLn $ "Writing result to " ++ outfile settings diff --git a/app/MimaRun/Main.hs b/app/MimaRun/Main.hs index 5f55c79..0aa8967 100644 --- a/app/MimaRun/Main.hs +++ b/app/MimaRun/Main.hs @@ -112,7 +112,7 @@ loadFlags :: Settings -> Run (Flags (MimaAddress -> Bool)) loadFlags settings = do let file = getFlagFile settings printFile "flags" file - mRawFlags <- loadFile readFlagFile file + mRawFlags <- loadFile' readFlagFile file pure $ case mRawFlags of Nothing -> noFlags Just flagSpec -> interpretFlagSpec $ getFlagSpec flagSpec @@ -121,7 +121,7 @@ loadSymbols :: Settings -> Run LabelSpec loadSymbols settings = do let file = getSymbolFile settings printFile "symbols" file - fromMaybe noLabels <$> loadFile readSymbolFile file + fromMaybe noLabels <$> loadFile' readSymbolFile file {- Other functions -} @@ -154,7 +154,6 @@ printState ms flags labels settings = do lift $ putStrLn "Dump of MiMa state:" lift $ T.putStrLn $ formatState formatEnv --- TODO exception handling main :: IO () main = doRun_ $ do settings <- lift $ execParser opts diff --git a/src/Mima/IO.hs b/src/Mima/IO.hs index 5e599f7..98990ac 100644 --- a/src/Mima/IO.hs +++ b/src/Mima/IO.hs @@ -6,10 +6,13 @@ module Mima.IO , doRun , doRun_ , tryRun - , File(..) , readTextFile + , writeTextFile , loadFile + , storeFile + , File(..) , loadFile' + , storeFile' ) where import Control.Monad.Trans.Class @@ -42,22 +45,40 @@ tryRun r = do lift $ putStrLn e pure Nothing +handleOpenFileError :: FilePath -> IOError -> IO (Either String a) +handleOpenFileError filepath e = if isRelevantError + then pure $ Left $ "Can't open file " <> filepath <> ": " <> ioeGetErrorString e + else ioError e + where + isRelevantError = isAlreadyInUseError e || isDoesNotExistError e || isPermissionError e + +readTextFile :: FilePath -> Run T.Text +readTextFile filepath = do + eitherContent <- lift $ catchIOError (Right <$> T.readFile filepath) (handleOpenFileError filepath) + except eitherContent + +writeTextFile :: FilePath -> T.Text -> Run () +writeTextFile filepath content = do + result <- lift $ catchIOError (Right <$> T.writeFile filepath content) (handleOpenFileError filepath) + except result + +loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a +loadFile f path = do + content <- readTextFile path + case f path content of + Left errorBundle -> throwE $ errorBundlePretty errorBundle + Right result -> pure result + +-- To have a consistent naming scheme +storeFile :: FilePath -> T.Text -> Run () +storeFile = writeTextFile + data File = NoFile | OptionalFile FilePath | RequiredFile FilePath deriving (Show) -readTextFile :: FilePath -> Run T.Text -readTextFile filepath = do - eitherContent <- lift $ catchIOError (Right <$> T.readFile filepath) handleError - except eitherContent - where - isRelevantError e = isAlreadyInUseError e || isDoesNotExistError e || isPermissionError e - handleError e = if isRelevantError e - then pure $ Left $ "Can't load file " ++ filepath ++ ": " ++ ioeGetErrorString e - else ioError e -- This error does not concern us - loadTextFile :: File -> Run (Maybe (FilePath, T.Text)) loadTextFile NoFile = pure Nothing loadTextFile (OptionalFile path) = do @@ -67,8 +88,8 @@ loadTextFile (RequiredFile path) = do content <- readTextFile path pure $ Just (path, content) -loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> File -> Run (Maybe a) -loadFile f file = do +loadFile' :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> File -> Run (Maybe a) +loadFile' f file = do mContent <- loadTextFile file case mContent of Nothing -> pure Nothing @@ -76,9 +97,7 @@ loadFile f file = do Left errorBundle -> throwE $ errorBundlePretty errorBundle Right result -> pure $ Just result -loadFile' :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a -loadFile' f path = do - content <- readTextFile path - case f path content of - Left errorBundle -> throwE $ errorBundlePretty errorBundle - Right result -> pure result +storeFile' :: File -> T.Text -> Run () +storeFile' NoFile _ = pure () +storeFile' (OptionalFile path) content = () <$ tryRun (writeTextFile path content) +storeFile' (RequiredFile path) content = writeTextFile path content