diff --git a/package.yaml b/package.yaml index 3956c4c..b2c184d 100644 --- a/package.yaml +++ b/package.yaml @@ -14,9 +14,11 @@ extra-source-files: dependencies: - base >= 4.7 && < 5 - OddWord >= 1.0 && < 1.1 + - aeson + - bytestring - containers - text - - aeson + - transformers - unordered-containers library: diff --git a/src/Mima/Run.hs b/src/Mima/Run.hs new file mode 100644 index 0000000..66ba107 --- /dev/null +++ b/src/Mima/Run.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Mima.Run + ( + -- * The 'Run' monad + Run + , run + , throw + , catch + , handle + -- * File operations + , readFileT + , writeFileT + , readFileBS + , writeFileBS + ) where + +import Control.Monad.IO.Class +import Control.Monad.Trans.Except +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.IO.Error + +newtype Run a = Run (ExceptT T.Text IO a) + deriving (Functor, Applicative, Monad, MonadIO) + +run :: Run a -> IO (Either T.Text a) +run (Run e) = runExceptT e + +throw :: T.Text -> Run a +throw = Run . throwE + +catch :: Run a -> (T.Text -> Run a) -> Run a +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 = 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 " <> ioeGetLocation e <> ": " <> ioeGetErrorString e + | otherwise = Nothing + +protect :: IO a -> Run a +protect m = do + result <- liftIO $ tryIOError m + case result of + Right a -> pure a + Left e -> case formatRelevantError e of + Nothing -> liftIO $ ioError e + Just msg -> throw msg + +readFileT :: FilePath -> Run T.Text +readFileT = protect . T.readFile + +writeFileT :: FilePath -> T.Text -> Run () +writeFileT path = protect . T.writeFile path + +readFileBS :: FilePath -> Run BS.ByteString +readFileBS = protect . BS.readFile + +writeFileBS :: FilePath -> BS.ByteString -> Run () +writeFileBS path = protect . BS.writeFile path