haskellfree-monad

Freer-Simple Freer Monads How do I Unify IO Exception Handling with Error Effect


I am using freer-simple to write a super simple DSL. All it does is read a file. I have one rule regarding file names, they cannot contain the letter x. Any attempt to open a file with the letter x in it will result in a: Left (AppError "No Xs allowed in file name").

How would I catch an IO error when reading a file in fileSystemIOInterpreter and throw it as an application error? Ie. I am trying to convert selected IO exceptions into AppErrors (see ??????).

{- File System Lang -}

data FileSystem r where
  ReadFile :: Path a File -> FileSystem StrictReadResult

readFile :: Members '[FileSystem, Error AppError] effs => Path a File -> Eff effs StrictReadResult
readFile path = let
                  pthStr = toStr $ toFilePath path
                in
                  F.elem 'x' pthStr
                        ? throwError (AppError "No Xs allowed in file name")
                        $ send $ ReadFile path

{- Errors -}

newtype AppError = AppError String deriving Show

runAppError :: Eff (Error AppError ': r) a -> Eff r (Either AppError a)
runAppError = runError

{- File System IO Interpreter -}

fileSystemIOInterpreter :: forall effs a. (Members '[Error AppError] effs, LastMember IO effs) => Eff (FileSystem ': effs) a -> Eff effs a
fileSystemIOInterpreter = interpretM $ \case
                                          ReadFile path -> F.readFileUTF8 path
                                          -- ??????

-- this compiles: fileSystemIOInterpreter effs = throwError $ AppError "BLahh"

application :: Members '[FileSystem, Error AppError] effs => Path a File -> Eff effs StrictReadResult
application = readFile

ioApp :: Path a File -> IO (Either AppError StrictReadResult)
ioApp path = runM
              $ runAppError
              $ fileSystemIOInterpreter
              $ application path

-- running the app

demoPassApp = ioApp [absfile|C:\Vids\SystemDesign\VidList.md|]
>> Right (Right "Text content of VidList.md")

demoFailApp = ioApp [absfile|C:\Vids\SystemDesign\VidList.txt|]
>> Left (AppError "No Xs allowed in file name")

demoFailIOApp = ioApp [absfile|C:\Vids\SystemDesign\MissingFile.md|]
>> *** Exception: C:\Vids\SystemDesign\MissingFile.md: openBinaryFile: does not exist (No such file or directory)
-- I want to turn this into an AppError

Solution

  • interpretM takes an interpreter in IO (its first argument has type eff ~> m with m ~ IO here), so that doesn't allow you to throw AppErrors via the Members '[Error AppError] effs constraint.

    Instead you can use interpret, with full access to effs. That would roughly look like:

    fileSystemIOInterpreter
      :: forall effs a
      .  (Members '[Error AppError] effs, LastMember IO effs)
      => Eff (FileSystem ': effs) a -> Eff effs a
    fileSystemIOInterpreter = interpret $ \case
        ReadFile path -> do
            r <- sendM (try (F.readFileUTF8 path))
            case r of
                Left (e :: IOException) -> throwError (ioToAppErr e)
                Right f -> pure f
    
    -- for some value of
    ioToAppErr :: IOException -> AppError