Tuesday, July 31, 2012

Free monad transformers

I'm spinning off the Control.Monad.Trans.Free module from pipes into its own package: transformers-free. Some people requested this because they wanted to experiment with the FreeT type in their own code without making pipes a full-blown dependency.

Free monad transformers

Recently I've evangelized the use of free monads for building abstract syntax trees that let you abstract away the interpreter. This lets you seamlessly build custom domain-specific languages in Haskell.

However, sometimes we can't specify the syntax tree all at once. Often we want to interleave the syntax tree with some other monad to generate streaming or interactive computations. FreeT solves this problem by allowing us to mix building steps of the abstract syntax tree with calling actions in some base monad:

newtype FreeT f m a = FreeT {
For example, let's say we want to write our own Python-style generator:
type Generator b m r = FreeT ((,) b) m r
In this case, our syntax tree is an ordinary list where we run the base monad to generate the next element. We can even duplicate Python syntax:
yield :: b -> Generator b m ()
yield b = liftF (b, ())
We can set the base monad to IO if we want to prompt the user to enter each subsequent element of the list:
prompt :: Generator String IO r
prompt = forever $ do
    lift $ putStrLn "Enter a string:"
    str <- lift getLine
    yield str
We can then demand the next element from our generator using runFreeT:
main = do
    x <- runFreeT prompt
    case x of
        Pure       _  -> return ()
        Free (str, _) -> putStrLn $ "User entered: " ++ str
This does not prompt the user for an infinite number of values. Instead, we only prompt the user to enter as many values as we demand from the generator, which was just one value in the above example. However, if we wanted to bleed our user dry, we could gratuitously demand the entire generator:
main = putStrLnAllTheThings prompt

putStrLnAllTheThings gen = do
    x <- runFreeT gen
    case x of
        Pure         _   -> return ()
        Free (str, gen') -> do
            putStrLn str
            putStrLnAllTheThings gen'
However, even that still streams the values and never retains them in memory.


Sometimes we want to give our free monad a complete denotation, but our base functor does not cut it. The classic example is simulating the State monad using a free monad. We could try adding the following two terms to our base functor to act like a State monad:
data BaseF s x
  = Get (s -> x)
  | Put s x
  | Something x
... and we even can write the following State-like primitives:
get' :: Free (BaseF s) s
get' = liftF $ Get id

put' :: s -> Free (BaseF s) ()
put' s = liftF $ Put s ()
... but these simulated primitives do not necessarily obey the State monad equations such as:
put x >> put y = put y
get >>= put = return ()
However, we can instead outsource part of the denotation to the actual State monad. All we do is delete the Get and Put constructors from our base functor:
data BaseF x
  = Something x
... and instead just use State (or StateT m) as the base monad:
doSomething :: FreeT BaseF (State s) ()
doSomething = do
    x <- lift get
    lift $ put x
The FreeT monad transformer is correct by construction, so we can use the monad transformer laws to equationally reason about our program to eliminate the dead code at the end of our function:
-- lift m >>= lift . f = lift (m >>= f)
doSomething = do
    lift $ do
        x <- get
        put x

-- get >>= put = return ()
doSomething = do
    lift $ return ()

-- lift (return x) = return x
doSomething = do
    return ()

-- return () >> m = m
doSomething = something
FreeT offers us a nice way to selectively outsource our denotation to other monads whenever we need stronger equational guarantees.

free compatibility

I do not intend to use transformers-free to replace the free package for free monads that are not monad transformers. Even in my own code I still use free for ordinary free monads. I only provide the ordinary Free type to keep the transformers tradition of formulating the ordinary monad in terms of the corresponding monad transformer.

When designing the transformers-free library, I tried to adhere to the free package as closely as possible for naming conventions. I really only disagree with one naming convention Edward used, which is naming one of the constructors Free, for two reasons:
  • It shares the same name as the type, which is confusing since it's not the only constructor.
  • It does not share the same name as its smart constructor, wrap, which is confusing because Pure does share the same name as its smart constructor, pure.
So he probably should have named the constructor Wrap, but I decided to stick with his name and not buck convention.

I also structured the FreeT type so that the derived Free type would resemble Free from the free package as closely as possible. The only difference is that in transformers-free you have to use the runFree observation function first before you can pattern match on the constructors, but otherwise it's identical:
-- using the "free" package
f :: Free f r -> ...
f x = case x of
    Pure r -> ...
    Free w -> ...

-- using the "transformers-free" package
f :: Free f r -> ...
f x = case runFree x of
    Pure r -> ...
    Free w -> ...
I also found that this was the most natural way to write the FreeT type and the easiest to use, based on my experience using it within the pipes library. Of course, your own mileage might vary!

I haven't copied all the functions that the free package provides. I mainly omitted the recursion schemes because there are a few other recursion schemes that I was also considering:
foldFree1 :: (a -> r) -> (f r -> r) -> Free f a -> r
-- or
foldFree2 :: (FreeF f a r -> r) -> Free f a -> r
... and their FreeT equivalents, which use m r as the carrier of the algebra instead:
foldFreeT1 :: (a -> m r) -> (f (m r) -> m r) -> FreeT f m a -> r
-- or
foldFreeT2 :: (FreeF f a (m r) -> m r) -> FreeT f m a -> r
In the end, I chose not to include anything yet and leave it up to discussion, since it is easier to add API functions than remove them.


I also wrote up a codensity version implemented using the following type:
newtype FreeT {
    foldFreeT :: (a -> m r) -> (f (m r) -> m r) -> m r }
This gives large speed differences for code that never uses the base monad. I'm on vacation, so I don't have access to my work computer to reproduce the benchmarks, but I vaguely remember that they ranged from a best case improvement of roughly 50% faster for operations on the tail of the list to a worst case penalty of roughly 30% slower for operations on the head of the list. However, for real world use cases where you intermingle IO operations like simple print statements at each step then the performance differences drop to less than 5%.

The main reasons I haven't released the codensity version yet are:
  • If I release multiple implementations, I want to type-class them with appropriate laws.
  • Type-class signatures cannot be easily updated, so I want to solidify the API first.
Note: Some reddit readers may remember me remarking on the naive implementation giving linear time complexity for left-associative code, but this was a false alarm: the code was actually right-associative. Since do notation is right-associative, the time complexity difference between left-associative code doesn't arise frequently in practice, but one should always still keep it in mind, especially when writing code like:
do x <- longFreeMonad

transformers compatibility

I'm proposing this library as a candidate for inclusion in the transformers package, so the documentation is structured very similarly.

I also provide a MonadIO instance for the type, something I was very reluctant to do since I consider MonadTrans to be sufficient for that purpose. However, I relented since:
  • I've gotten a lot of feedback in favor of a MonadIO instance for this type
  • If this ever does get accepted into transformers, it will get a MonadIO instance anyway.


The FreeT type (or its isomorphic codensity version) arises very frequently in iteratee libraries. For example, the Iteratee type from the enumerator package is isomorphic to:
data IterateeF a next
  = Continue (a -> next)
  | Error SomeException
Iteratee a m r ~ FreeT (IterateeF (Stream a)) (r, Stream a)
The Iteratee type from the iteratee package is isomorphic to:
data IterateeF a next
  = Await (a -> next) (Maybe SomeException)

The Pipe type from pipes is:
data PipeF a b next
  = Await (a -> next)
  | Yield (b, next)

type Pipe a b m r = FreeT (PipeF a b) m r
And the Pipe type from conduit is (sort of) isomorphic to:
data ConduitF l i o u m next
  = HaveOutput (m ()) o next
  | NeedInput (i -> next) (u -> next)
  | LeftOver l next

Pipe l i o u m r ~ FreeT (ConduitF l i o u m) m r
I say "sort of" because conduit followed the pipes-1.0 approach that made the base monad optional, which only gives a correct monad transformer when viewed through the lens of runPipe. However, in principle, conduit with congruence laws implements something isomorphic to FreeT since conduit requires its users only use runPipe to inspect conduits.


The pipes-2.2 package now uses transformers-free to provide Control.Monad.Trans.Free meaning that Pipe now has a MonadIO instance, something which many people have requested before.

Also, if you install transformers-free on its own and have an existing pipes installation, make sure that you upgrade pipes to version 2.2 to avoid conflicting exports for Control.Monad.Trans.Free.

However, I have no plans yet to shift Control.IMonad.Trans.Free to an external package since I doubt other people will use it any time in the near future.


The transformers-free package provides the unifying theoretical abstraction for streaming or interactive programs: the free monad transformer. Once you learn the abstraction, you will start to see it everywhere, even in non-iteratee libraries.

Thursday, July 19, 2012

First-class modules without defaults





Dan's ByteStringModule looks like this:
data ByteStringModule = S
  , length :: ByteString -> Int
  , singleton :: Word8 -> ByteString
  , null :: ByteString -> Bool
  , pack :: [Word8] -> ByteString
  , unpack :: ByteString -> [Word8]
  , empty :: ByteString
  , readFile :: FilePath -> IO ByteString

_Data_ByteString_ :: ByteStringModule
_Data_ByteString_ = S
  { null = ...
    ... }

instance Default ByteStringModule where
  def = _Data_ByteString_
data StringModule s = String
  , length :: s -> Int
  , singleton :: Word8 -> s
  , null :: s -> Bool
  , pack :: [Word8] -> s
  , unpack :: s -> [Word8]
  , empty :: s
  , readFile :: FilePath -> IO s
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Prelude as P

lazyByteString :: StringModule L.ByteString
lazyByteString = String {
    null = L.null,
    ... }

strictByteString :: StringModule S.ByteString
strictByteString = String {
    null = S.null,
    ... }

text :: StringModule T.Text
text = String {
    null = T.null,
    ... }

string :: StringModule P.String
string = String {
    null = P.null,
    ... }
class StringModule s where
    length :: s -> Int
    singleton :: Word8 -> s
    null :: s -> Bool
    pack :: [Word8] -> s
    unpack :: s -> [Word8]
    empty :: s
    readFile :: FilePath -> IO s
    writeFile :: FilePath -> s -> IO ()


This improvement has several advantages over Chris's original approach:
  • You can program generically over the StringModule "class"



zot :: (L.ByteString, S.ByteString)
zot = (a,b) where
zot = (a,b) where
l = lazyByteString
s = strictByteString

zot = (a,b) where
zot = (a,b) where
  l = lazyByteString
  s = strictByteString
zot :: StringModule s -> (s, s)
zot s = (a,b) where
  String{..} = s
  a = pack [1,2,3]
  b = pack [1,2,3]

l = lazyByteString
s = strictByteString

zot = (a,b) where
  a = pack l [1,2,3]
  b = pack s [1,2,3]

zot s = (a, b) where
  a = L.pack def [1,2,3]
  b = S.pack def [1,2,3]

data OuterModule a = Out { outVal :: a }
data InnerModule a = In  {  inVal :: a }

dict :: OuterModule (InnerModule String)
dict = Out (In "Hello, world!")

contrived :: String
contrived = inVal (outVal dict) -- nested qualified import

Common features

L {..} = def
... and for my variation you would use:
String {..} = lazyByteString



Wednesday, July 18, 2012

Purify code using free monads

  • You can formally prove things about your code
  • Barring that, you can reason easily about your code
  • If all else fails, you can QuickCheck your code
To demonstrate this, I'll use the following simple echo program:
import System.Exit

main = do x <- getLine
          putStrLn x
          putStrLn "Finished"

Free monads

import Control.Monad.Free
import System.Exit hiding (ExitSuccess)

data TeletypeF x
  = PutStrLn String x
  | GetLine (String -> x)
  | ExitSuccess

instance Functor TeletypeF where
    fmap f  ExitSuccess     = ExitSuccess

type Teletype = Free TeletypeF

putStrLn' :: String -> Teletype ()
putStrLn' str = liftF $ PutStrLn str ()

getLine' :: Teletype String
getLine' = liftF $ GetLine id

exitSuccess' :: Teletype r
exitSuccess' = liftF ExitSuccess

run :: Teletype r -> IO r
run (Pure r) = return r
run (Free  ExitSuccess    ) = exitSuccess

echo :: Teletype ()
echo = do str <- getLine'
          putStrLn' str
          putStrLn' "Finished"

main = run echo



import System.Exit

main = do x <- getLine
          putStrLn x
          putStrLn "Finished" <-- oops!

exitSuccess :: IO ()
exitSuccess = return ()

exitSuccess' >> m = exitSuccess'
exitSuccess' >> m

-- exitSuccess' = liftF ExitSuccess
= liftF ExitSuccess >> m

= liftF ExitSuccess >>= \_ -> m

-- liftF f = Free (fmap Pure f)

-- fmap f ExitSuccess = ExitSuccess
= Free ExitSuccess >>= \_ -> m


-- fmap f ExitSuccess = ExitSuccess
= Free ExitSuccess

-- fmap f ExitSuccess = ExitSuccess
= Free (fmap Pure ExitSuccess)

-- liftF f = Free (fmap Pure f)
= liftF ExitSuccess

-- exitSuccess' = liftF ExitSuccess
= exitSuccess'

exitSuccess' >> m = exitSuccess'


putStrLn str = return () -- worst maintainer, ever
runPure (Pure r)                  xs  = []
runPure (Free  ExitSuccess   )    xs  = []
Now, we can prove that:
runPure echo = take 1








>>> import Test.QuickCheck
+++ OK, passed 100 tests.


  • prove soundness,
  • reason about behavior, and
  • aggressively test.


Wednesday, July 11, 2012

Breaking from a loop

This post describes how to break from a code block by using EitherT/MaybeT instead of ContT. This technique isn't new, and has already been described at least once before here. However, there is still some weird culture of teaching ContT for exiting from loops, which is incredibly over-kill and bad practice because it makes beginners think it's complicated when it's not.

The Trick

Exiting from a code block is ridiculously simple:
import Control.Error -- from the 'errors' package
import Control.Monad
import Control.Monad.Trans

exit = left -- or rename 'exit' to 'break' if you prefer

main = runEitherT $ forever $ do
    str <- lift getLine
    when (str == "exit") $ exit ()
I find this significantly easier to understand than the equivalent ContT version. Normally when you use Either/EitherT, you terminate on the first Left you encounter. All that exit does is return its argument wrapped in a Left, halting the surrounding EitherT block.

You can even use the value returned from the block, which will be a Left if the block exited with a exit statement, or a Right if the block terminated normally:
main = do
    e <- runEitherT $ forever $ do
        str <- lift getLine
    case e of
        Left  a -> ... -- Loop terminated with an 'exit'
        Right b -> ... -- Loop terminated normally
This approach is incredibly simple and lets you distinguish how the loop terminates. If you don't care about distinguishing the two code paths and they return the same result type, then just use:
main = do
    r <- fmap (either id id) $ runEitherT $ ...
... which also works if the loop is non-terminating.

If you want to exit without returning any value, just use MaybeT instead:
exit = mzero

main = runMaybeT $ forever $ do
    str <- lift getLine
    when (str == "exit") exit
Or you could stick with EitherT and just use exit (), as the first example did, since Either () r is isomorphic to Maybe r.

EitherT vs. ErrorT

You might wonder why people historically teach ContT instead of EitherT for exiting from loops. I can only guess that they did this because of the terrible EitherT implementation in the transformers package that goes by the name ErrorT. The ErrorT implementation makes two major mistakes:
  • It constrains the Left value with the Error class.
  • The name mistakenly misleads users to believe that the Left value is only useful for returning errors.
The first mistake prevents you from exiting with any old value unless you first make it an instance of the Error class. The second mistake insidiously misleads new Haskell programmers to miss the opportunity to exit from EitherT blocks using ordinary non-exceptional values and then they get led astray by people peddling ContT.

The above examples worked because they didn't use ErrorT at all and instead used the superior implementation in the either package which doesn't constrain the behavior of the Left value, either practically or semantically. This is why you should always give data types neutral names to encourage people to use them in ways you didn't anticipate.

Nested blocks

You might think you need ContT if you want to do anything more complicated such as multiple levels of nesting and exiting. However, if you thought so you'd be wrong! Nesting multiple EitherT blocks works perfectly fine:
-- I'm too lazy to add type signatures for this
{-# LANGUAGE NoMonomorphismRestriction #-}

import Control.Error
import Control.Monad
import Control.Monad.Trans

exit = left

main =
    runEitherT $ forM_ [1..3] $ \i ->
        runEitherT $ forM_ [4..6] $ \j -> do
            when (j == 6) $ liftInner $ exit ()
            liftIO $ print (i, j)
  where liftInner = id
        liftOuter = lift
        liftIO    = lift . lift
Let's check it out:
$ ./break
I can choose to break out of two nested levels by replacing liftInner with liftOuter, which just lifts the exit call to the surrounding EitherT block:
            when (j == 6) $ liftOuter $ exit ()
$ ./break
(1, 4)
(1, 5)
Nice! Mainstream languages require extended syntax to let you break out of multiple nested loops. Haskell does it using ordinary functions. I really can't convey how amazing that is without being entirely unprofessional.

Sunday, July 8, 2012

errors-1.0: Simplified error handling


ghc-pkg hide EitherT
Which will hide the EitherT package so it does not conflict.




import Control.Monad.Trans.Either
import Data.Maybe
import Safe
You now can just import:
import Control.Error

Utility Functions

hush       :: Either a b -> Maybe b


Precis.Utils.ControlOperators.suppress :: Either e a -> Maybe a



liftMaybe  = MaybeT  . return
liftEither = EitherT . return

Social Confirmation






type Script a = EitherT String IO a
         Control.Error.Util and only catches IO exceptions -}
tryIO :: IO a -> Script a
tryMaybe :: String -> Maybe a -> Script a
tryEither :: Either String r -> Script r


import Control.Error
import System.Environment

main = runScript $ do
    as <- tryIO getArgs
    (file, n) <- case as of
        [file, n'] -> do
            n <- tryRead "Could not parse LINENUM" n'
            return (file, n)
        _ -> throwT "Usage: MYPROGRAM FILE LINENUM"
    str <- tryIO $ readFile file
    tryIO $ putStrLn line
Notice the pattern? Everything that can be bound in the Script monad begins with the prefix try. A future release of the library will also provide versions with the default error messages (i.e. "Prelude.read: no parse"), but I just haven't decided what to name those versions, yet.


Why not ErrorT?




-- The non-monad-transformer versions, for simplicity
throwError :: e -> Either e r
throwE/return :: a -> Either a r

return :: a -> EitherR r a
return :: a ->         m a
return = throwE -- except with newtypes

(>>=) = catchE -- except with newtypes
runEitherRT $ do
    e2 <- ioExceptionHandler e1
    bool <- arithmeticExceptionhandler e2
    when bool $ lift $ putStrLn "DEBUG: Something happened"
    succeed () -- the dual of "throw"
    -- Statements beyond here will not be evaluated

Laws for throwE and catchE

-- return x >>= f = f x
throwE x `catchE` f = f x

-- m >>= return = m
m `catchE` throwE = m

  • If you throw a value, the catch block processes it
  • Catch blocks are associative

throwE :: e -> Either e r








Sunday, July 1, 2012

pipes-2.1 and index-core-1.0 - Indexed types

  • Frames are now unified into a single type
  • The newtype is gone
take' n = do
    replicateMR_ $ do
        a <- await
        yield a
    liftU $ putStrLn "You shall not pass"

Indexed types






-- Upgrading IO to work in an indexed do block
unU $ do
    str <- u getLine
    u $ putStrLn str
-- Downgrading Frame to work in an ordinary do block
unD $ do
    a <- D await
    D $ yield a




strict = toList >>= fromList
toList = do
    a' <- awaitF
    case a' of
        Nothing -> return []
        Just a  -> do
            as <- toList
            return (a:as)




The Streaming Haskell Group

  • The tools to work with indexed types
  • An instructive library to consult as a reference
  • A motivating example for the practical benefits of indexed types

Future Directions



