Я играю с freer-simple и пытаюсь разобраться, как комбинировать эффекты.
У меня есть алгебра для представления простой файловой системы, и пользователь вызвал ошибку следующим образом:
data FileSystem r where
ReadFile :: Path a File -> FileSystem String
WriteFile :: Path a File -> String -> FileSystem ()
readFile :: Member FileSystem effs => Path a File -> Eff effs String
readFile = send . ReadFile
writeFile :: Member FileSystem effs => Path a File -> String -> Eff effs ()
writeFile pth = send . WriteFile pth
data AppError r where
Ensure :: Bool -> String -> AppError ()
Fail :: String -> AppError ()
ensure :: Member AppError effs => Bool -> String -> Eff effs ()
ensure condition message = send $ Ensure condition message
fail :: Member AppError effs => String -> Eff effs ()
fail = send . Fail
И «приложение» в функции, называемой интерактором, следующим образом:
data TestItem = Item {
pre :: String,
post :: String,
path :: Path Abs File
}
data RunConfig = RunConfig {
environment :: String,
depth :: Integer,
path :: Path Abs File
}
type FileSys r = (Member FileSystem r)
type AppFailure r = (Member AppError r)
interactor :: TestItem -> RunConfig -> (AppFailure r, FileSys r) => Eff r ApState
interactor item runConfig = do
let fullFilePath = path (runConfig :: RunConfig)
writeFile fullFilePath $ pre item <> post item
fail "random error ~ its a glitch"
txt <- readFile [absfile|C:\Vids\SystemDesign\Wrong.txt|]
pure $ ApState fullFilePath txt
На данном этапе меня интересуют только тупые «документальные» интерпретаторы, которые регистрируют шаги.даже не волнует, что будет с ошибкой с точки зрения потока управления:
fileSystemDocInterpreter :: FileSystem ~> Eff '[Writer [String], effs]
fileSystemDocInterpreter =
let
mockContents = "Mock File Contents"
in
\case
ReadFile path -> tell ["readFile: " <> show path] $> mockContents
WriteFile path str -> tell ["write file: " <>
show path <>
"\nContents:\n" <>
str]
errorDocInterpreter :: AppError ~> Eff '[Writer [String]]
errorDocInterpreter = \case
Ensure condition errMsg -> tell [condition ? "Ensure Check Passed" $
"Ensure Check Failed ~ " <> errMsg]
Fail errMsg -> tell ["Failure ~ " <> errMsg]
Комбинированный интерпретатор выглядит следующим образом:
type FileSys r = (Member FileSystem r)
type AppFailure r = (Member AppError r)
executeDocumented :: forall a. Eff '[FileSystem, AppError] a -> ((a, [String]), [String])
executeDocumented app = run $ runWriter
$ reinterpret errorDocInterpreter
$ runWriter
$ reinterpret fileSystemDocInterpreter app
Когда я запускаю это с примерами конфигураций, я получаю что-токак следующее:
((ApState {
filePath = "C:\\Vids\\SystemDesign\\VidList.txt",
fileText = "Mock File Contents"
},
["write file: \"C:\\\\Vids\\\\SystemDesign\\\\VidList.txt\
"\nContents: I do a test the test runs",
"readFile: \"C:\\\\Vids\\\\SystemDesign\\\\Wrong.txt\""]
),
["Failure ~ random error ~ its a glitch"]
)
У меня есть пара вопросов о переводчиках выше:
Для того, чтобы это скомпилировать, я должен был сделать типы следующим образом:
fileSystemDocInterpreter :: FileSystem ~> Eff '[Writer [String], effs]
errorDocInterpreter :: AppError ~> Eff '[Writer [String]]
и вызов errorDocInterpreter после fileSystemDocInterpreter, потому что fileSystemDocInterpreter имеет конечные эффы, а errorDocInterpreter нет.
Есть ли способ изменить сигнатуры типа иливызвать их, так что не имеет значения, что было необходимо елиSt от родительского переводчика?
И fileSystemDocInterpreter, и errorDocInterpreter используют эффект Writer [String].Есть ли способ объединить их так, чтобы runWriter вызывался только один раз, чтобы сообщения об ошибках и файловой системе появлялись в одном журнале?