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.)
CodePudding user response:
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 fmap
ping 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'