transformers-free-1.0.0: Free monad transformers

Safe HaskellSafe-Infered

Control.Monad.Trans.Free

Contents

Description

Free monads build syntax trees. See the example sections for details.

A free monad over a functor resembles a list of that functor:

  • return behaves like [] by not using the functor at all
  • wrap behaves like (:) by prepending another layer of the functor
  • liftF behaves like singleton by creating a list from a single layer of the functor.

Synopsis

Usage

You can assemble values of type Free f a or FreeT f m a by hand using the smart constructors return (from Control.Monad) and wrap:

 return ::              r  -> FreeT f m r
 wrap   :: f (FreeT f m r) -> FreeT f m r

Use runFree to deconstruct values of type Free f r:

 case runFree x of
     Pure a -> ...
     Free w -> ...

Use runFreeT to deconstruct values of type FreeT f m r and bind the result in the base monad m. You can then pattern match against the bound value:

 do x <- runFreeT f
    case x of
        Pure a -> ...
        Free w -> ...

Free monad

type Free f = FreeT f IdentitySource

Free f a is a list of nested fs terminating with a return value of type a.

  • f - The functor that generates the free monad
  • a - The return value

data FreeF f a x Source

The signature for Free

Constructors

Pure a 
Free (f x) 

runFree :: Free f r -> FreeF f r (Free f r)Source

Observation function that exposes the next step

Free monad transformer

newtype FreeT f m a Source

A free monad transformer alternates nesting the base monad m and the base functor f, terminating with a value of type a.

  • f - The functor that generates the free monad transformer
  • m - The base monad
  • a - The return value

Constructors

FreeT 

Fields

runFreeT :: m (FreeF f a (FreeT f m a))
 

Instances

MonadTrans (FreeT f) 
(Functor f, Monad m) => Monad (FreeT f m) 
(Functor f, Monad m) => Functor (FreeT f m) 
(Functor f, Monad m) => Applicative (FreeT f m) 
(Functor f, MonadIO m) => MonadIO (FreeT f m) 

Free monad operations

wrap :: Monad m => f (FreeT f m a) -> FreeT f m aSource

Prepend one layer of the functor to the free monad

liftF :: (Functor f, Monad m) => f a -> FreeT f m aSource

Convert one layer of a functor into an operation in the free monad

Free monad example

To create a syntax tree, first define the signature for a single step in the syntax tree:

 data TeletypeF next = PutString String next | GetString (String -> next)

... then make the signature a Functor, where fmap applies the given function to the next step:

 instance Functor TeletypeF where
     fmap f (PutString str x) = PutString str (f x)
     fmap f (GetString     k) = GetString (f . k)

The Free type constructor generates the corresponding syntax tree from this signature:

 type Teletype a = Free TeletypeF a

liftF creates primitive operations for building the syntax tree:

 putString :: String -> Teletype ()
 putString str = liftF $ PutString str ()

 getString :: Teletype String
 getString = liftF $ GetString id

The syntax tree is automatically a monad, so you can assemble these operations into larger syntax trees using do notation:

 echo :: Teletype a
 echo = forever $ do
     str <- getString
     putString str

... which is equivalent to the following hand-written syntax tree:

 echo' :: Teletype r
 echo' = wrap $ GetString $ \str -> wrap $ PutString str echo'

You then interpret the syntax tree using runFree to inspect the tree one step at a time.

 runIO :: Teletype a -> IO a
 runIO t = case runFree t of
     Pure r -> return r
     Free (PutString str t') -> do
         putStrLn str
         runIO t'
     Free (GetString     k ) -> do
         str <- getLine
         runIO (k str)
>>> runIO echo
A<Enter>
A
Test<Enter>
Test
...

You can write pure interpreters, too:

 runPure :: Teletype a -> [String] -> [String]
 runPure t strs = case runFree t of
     Pure r -> []
     Free (PutString str t') -> str:runPure t' strs
     Free (GetString     k ) -> case strs of
         []        -> []
         str:strs' -> runPure (k str) strs'
>>> runPure echo ["A", "Test"]
["A","Test"]

Free monad transformer example

The Free monad transformer FreeT lets us invoke the base monad to build the syntax tree. For example, you can use IO to prompt the user to select each step of the syntax tree using the following monad:

 FreeT TeletypeF IO r

Our original primitives actually had the following more polymorphic types, so you can reuse them:

 putString :: (Monad m) => String -> FreeT TeletypeF m ()
 putString str = liftF $ PutString str ()

 getString :: (Monad m) => FreeT TeletypeF m String
 getString = liftF $ GetString id

Now the user can build the syntax tree from the command line:

 prompt :: FreeT TeletypeF IO ()
 prompt = do
     lift $ putStrLn "Supply the next step:
     cmd <- lift getLine
     case cmd of
         "forward" -> do
             str <- getString
             putString str
             prompt
         "greet" -> do
             putString "Hello, world!"
             prompt
         _ -> return ()

You can then run the syntax tree as the user builds it:

 -- The 'FreeT' version of 'runIO'
 runTIO :: FreeT TeletypeF IO r -> IO r
 runTIO t = do
     x <- runFreeT t
     case x of
         Pure r -> return r
         Free (PutString str t') -> do
             putStrLn str
             runTIO t'
         Free (GetString k) -> do
             str <- getLine
             runTIO (k str)
>>> runTIO prompt
Supply the next step:
greet<Enter>
Hello, world!
Supply the next step:
forward<Enter>
test<Enter>
test
Supply the next step:
quit<Enter>