1

我正在尝试扩展此博客文章中解释的玩具示例。

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}

module FreeToy where

import Control.Monad.State
import Control.Monad.Free
import Data.Map (Map)
import qualified Data.Map as M


-- defining commands
data Toy a next = 
          Output a next
        | AnnoyingOutput a (String -> next)
        | Done
        deriving (Functor)

-- lifing commands to free monad level
output :: a -> Free (Toy a) ()
output x = liftF $ Output x ()

annoyingOutput :: a -> Free (Toy a) {-some type-}
annoyingOutput x = liftF $ AnnoyingOutput x {-some function-}

done :: Free (Toy a) r
done = liftF $ Done

-- defining one of the interpreter
runToy :: (Show a, Show r) => Free (Toy a) r -> String
runToy (Free (Output a x)) =
    "output " ++ show a ++ "\n" ++ runToy x
runToy (Free (AnnoyingOutput a f)) = 
    "annoying output " ++ show a ++ runToy (f "blah blah blah \n")
runToy (Free Done) =
    "done\n"
runToy (Pure r) =
    "return " ++ show r ++ "\n"

我尝试添加的新内容是AnnoyingOutput a (String -> next)这将需要一些东西并返回字符串消息。我是结构，同时使用liftF函数将它提升到 Free monad 级别。请帮我填空，适当的解释是可观的。

编辑：添加示例

module Main where

import FreeToy
import Control.Monad.Free

program ::  Free (Toy String) ()

program = do
      output "something"
      x <- annoyingOutput "something else"
      output x
      done

main :: IO ()
main = putStrLn $ runToy program
4

0 回答 0