Freer-Simple Freer Monads Как объединить обработку исключений ввода-вывода с эффектом ошибки - PullRequest
0 голосов
/ 01 сентября 2018

Я использую freer-simple , чтобы написать супер простой DSL. Все, что он делает, это читает файл. У меня есть одно правило относительно имен файлов, они не могут содержать букву х. Любая попытка открыть файл с буквой x в нем приведет к: Left (AppError "No Xs allowed in file name").

Как бы я перехватил ошибку ввода-вывода при чтении файла в fileSystemIOInterpreter и выдал ее как ошибку приложения? То есть. Я пытаюсь преобразовать выбранные исключения ввода-вывода в ошибки AppErrors (см. ??????).

{- 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

1 Ответ

0 голосов
/ 01 сентября 2018

interpretM принимает интерпретатор в IO ( его первый аргумент имеет тип eff ~> m с m ~ IO здесь), так что не позволяет вам выбрасывать AppError s через Members '[Error AppError] effs ограничение.

Вместо этого вы можете использовать interpret с полным доступом к effs. Это было бы примерно так:

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
...