如何编写自由 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
我想组成两个免费的单子 ConsoleM
和 FileM
。所以,我制作了复合仿函数 Program
。然后我开始写解释器函数runProgram
,但是我不能定义函数。因为 runConsole
和 MaybeT 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))
。您可以通过 fmap
ping 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'
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
我想组成两个免费的单子 ConsoleM
和 FileM
。所以,我制作了复合仿函数 Program
。然后我开始写解释器函数runProgram
,但是我不能定义函数。因为 runConsole
和 MaybeT 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))
。您可以通过 fmap
ping 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'