Garmelon/mima-tools
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Catch and print all IOErrors

Browse source
This commit is contained in:
Joscha 2020-03-29 11:39:20 +00:00
parent 7b7a363693
commit b9f9d27105
2 changed files with 2 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

2
mima-run/Main.hs
View file

@ -15,7 +15,7 @@ import Mima.Vm.Storage
loadMetadataOrEmpty :: FilePath -> Run Metadata loadMetadataOrEmpty :: FilePath -> Run Metadata
loadMetadataOrEmpty path = catch (loadMetadata path) $ \e -> do loadMetadataOrEmpty path = catch (loadMetadata path) $ \e -> do
liftIO $ putStrLn $ "Metafile could not be loaded. " ++ T.unpack e liftIO $ putStrLn $ "Metafile could not be loaded: " ++ T.unpack e
pure mempty pure mempty
main :: IO () main :: IO ()

16
src/Mima/Run.hs
View file

@ -19,7 +19,6 @@ module Mima.Run
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Except import Control.Monad.Trans.Except
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import System.Exit import System.Exit
@ -50,25 +49,12 @@ catch (Run a) f = Run $ catchE a (\x -> let (Run result) = f x in result)
handle :: (T.Text -> Run a) -> Run a -> Run a handle :: (T.Text -> Run a) -> Run a -> Run a
handle = flip catch handle = flip catch
isRelevantError :: IOError -> Bool
isRelevantError e = isAlreadyInUseError e || isDoesNotExistError e || isPermissionError e
formatRelevantError :: IOError -> Maybe T.Text
formatRelevantError e
| isRelevantError e = Just $ T.pack $
"Can't open file " <> fileName <> ": " <> ioeGetErrorString e
| otherwise = Nothing
where
fileName = fromMaybe "<unknown>" $ ioeGetFileName e
protect :: IO a -> Run a protect :: IO a -> Run a
protect m = do protect m = do
result <- liftIO $ tryIOError m result <- liftIO $ tryIOError m
case result of case result of
Right a -> pure a Right a -> pure a
Left e -> case formatRelevantError e of Left e -> throw $ T.pack $ show e
Nothing -> liftIO $ ioError e
Just msg -> throw msg
readFileT :: FilePath -> Run T.Text readFileT :: FilePath -> Run T.Text
readFileT = protect . T.readFile readFileT = protect . T.readFile