How to compose Free Monads

Question

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

I want to compose two free monads ConsoleM and FileM. So, I made composed functor Program. Then I started to write interpreter functrion runProgram, but I cannot define the function. Because runConsole and MaybeT IO a types are not matched. How can I lift runConsole function runConsole :: Console (IO a) -> IO a to have type Console (MaybeT IO a) -> MaybeT IO a?

(I want to implement this program with Free monads for practice, not Eff monad.)

Answer 1

Now you have cmd' of type Console (MaybeT IO a), and want to pass it to a function taking Console (IO a). The first thing you can do is to run the MaybeT monad inside Console and get Console (IO (Maybe a)). You can do this by fmapping runMaybeT.

Once you got Console (IO (Maybe a)), you can pass it to runConsole and get IO (Maybe a). Now, you can lift it to MaybeT IO a using MaybeT.

So it'll be something like this.

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