如何编写自由 Monad

How to compose Free Monads

data Console a
  = PutStrLn String a
  | GetLine (String -> a)
  deriving (Functor)

type ConsoleM = Free Console

runConsole :: Console (IO a) -> IO a
runConsole cmd =
  case cmd of
    (PutStrLn s next) -> do
      putStrLn s
      next
    (GetLine nextF) -> do
      s <- getLine
      nextF s

runConsoleM :: ConsoleM a -> IO a
runConsoleM = iterM runConsole

consolePutStrLn :: String -> ConsoleM ()
consolePutStrLn str = liftF $ PutStrLn str ()
consoleGetLine :: ConsoleM String
consoleGetLine = liftF $ GetLine id


data File a
  = ReadFile FilePath (String -> a)
  | WriteFile FilePath String a
  deriving (Functor)

type FileM = Free File

runFile :: File (MaybeT IO a) -> MaybeT IO a
runFile cmd = case cmd of
  ReadFile path next -> do
    fileData <- safeReadFile path
    next fileData
  WriteFile path fileData next -> do
    safeWriteFile path fileData
    next

runFileM :: FileM a -> MaybeT IO a
runFileM = iterM runFile

rightToMaybe :: Either a b -> Maybe b
rightToMaybe = either (const Nothing) Just

safeReadFile :: FilePath -> MaybeT IO String
safeReadFile path =
  MaybeT $ rightToMaybe <$> (try $ readFile path :: IO (Either IOException String))

safeWriteFile :: FilePath -> String -> MaybeT IO ()
safeWriteFile path fileData =
  MaybeT $ rightToMaybe <$> (try $ writeFile path fileData :: IO (Either IOException ()))

fileReadFile :: FilePath -> FileM String
fileReadFile path = liftF $ ReadFile path id
fileWriteFile :: FilePath -> String -> FileM ()
fileWriteFile path fileData = liftF $ WriteFile path fileData ()


data Program a = File (File a) | Console (Console a)
  deriving (Functor)
type ProgramM = Free Program

runProgram :: Program (MaybeT IO a) -> MaybeT IO a
runProgram cmd = case cmd of
  File cmd' ->
    runFile cmd'
  Console cmd' ->
    -- ????

runProgramM :: ProgramM a -> MaybeT IO a
runProgramM = iterM runProgram

我想组成两个免费的单子 ConsoleMFileM。所以,我制作了复合仿函数 Program。然后我开始写解释器函数runProgram,但是我不能定义函数。因为 runConsoleMaybeT IO a 类型不匹配。如何将 runConsole 函数 runConsole :: Console (IO a) -> IO a 提升为类型 Console (MaybeT IO a) -> MaybeT IO a?

(我想用 Free monads 来练习这个程序,而不是 Eff monad。)

现在您有 cmd' 类型 Console (MaybeT IO a),并希望将其传递给采用 Console (IO a) 的函数。您可以做的第一件事是 运行 MaybeT monad inside Console 并得到 Console (IO (Maybe a))。您可以通过 fmapping runMaybeT.

一旦你得到Console (IO (Maybe a)),你可以将它传递给runConsole并得到IO (Maybe a)。现在,您可以使用 MaybeT.

将其提升至 MaybeT IO a

所以它会是这样的。

runProgram :: Program (MaybeT IO a) -> MaybeT IO a
runProgram cmd = case cmd of
  File cmd' ->
    runFile cmd'
  Console cmd' ->
    MaybeT $ runConsole $ fmap runMaybeT cmd'