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
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 AppError
s 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