##### Views

(Difference between revisions)
data Maybe a = Nothing | Just a
- - - - - - - Meet the Monads Meet the Monads - - -
Prev: [[introduction.html|Introduction]]TOC: [[index.html|Contents]]Next: [[class.html|Doing it with class]]
data Maybe a = Nothing | Just a
+ - Maybe is a type constructor and Nothing and Just are data constructors. You can construct a data value by applying the Just data constructor to a value: + data Maybe a = Nothing | Just a + + Maybe is a type constructor and Nothing and Just are data constructors. You can construct a data value by applying the Just data constructor to a value: -
country = Just "China"
+ - In the same way, you can construct a type by applying the Maybe type constructor to a type: + country = Just "China" + + In the same way, you can construct a type by applying the Maybe type constructor to a type: -
lookupAge :: DB -> String -> Maybe Int
+ - Polymorphic types are like containers that are capable of holding values of many different types. So Maybe Int can be thought of as a Maybe container holding an Int value (or Nothing) and Maybe String would be a Maybe container holding a String value (or Nothing). In Haskell, we can also make the type of the container polymorphic, so we could write "m a" to represent a container of some type holding a value of some type! + lookupAge :: DB -> String -> Maybe Int + + Polymorphic types are like containers that are capable of holding values of many different types. So Maybe Int can be thought of as a Maybe container holding an Int value (or Nothing) and Maybe String would be a Maybe container holding a String value (or Nothing). In Haskell, we can also make the type of the container polymorphic, so we could write "m a" to represent a container of some type holding a value of some type! - We often use type variables with type constructors to describe abstract features of a computation. For example, the polymorphic type Maybe a is the type of all computations that may return a value or Nothing. In this way, we can talk about the properties of the container apart from any details of what the container might hold. + We often use type variables with type constructors to describe abstract features of a computation. For example, the polymorphic type Maybe a is the type of all computations that may return a value or Nothing. In this way, we can talk about the properties of the container apart from any details of what the container might hold. [[Image:info.png]] If you get messages about "kind errors" from the compiler when working with monads, it means that you are not using the type constructors correctly.
[[Image:info.png]] If you get messages about "kind errors" from the compiler when working with monads, it means that you are not using the type constructors correctly.
-- the type of monad m                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            -- the type of monad m
data m a = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             data m a = ...

-- return is a type constructor that creates monad instances                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- return is a type constructor that creates monad instances
-                                                                            return :: a -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            return :: a -> m a

-- bind is a function that combines a monad instance m a with a computation                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -- bind is a function that combines a monad instance m a with a computation
-- that produces another monad instance m b from a's to produce a new                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- that produces another monad instance m b from a's to produce a new
-                                                                            (>>=) :: m a -> (a -> m b) -> m b
type Sheep = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            type Sheep = ...

-                                                                            father :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            father :: Sheep -> Maybe Sheep
father = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               father = ...

-                                                                            mother :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            mother :: Sheep -> Maybe Sheep
-                                                                            mother = ...
+ mother = ... + Then, defining functions to find grandparents is a little more complicated, because we have to handle the possibility of not having a parent: Then, defining functions to find grandparents is a little more complicated, because we have to handle the possibility of not having a parent: -
maternalGrandfather :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
+                                                                                                                            maternalGrandfather :: Sheep -> Maybe Sheep
maternalGrandfather s = case (mother s) of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 maternalGrandfather s = case (mother s) of
-                                                                            Nothing -> Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            Nothing -> Nothing
-                                                                            Just m  -> father m
+ Just m -> father m + and so on for the other grandparent combinations. and so on for the other grandparent combinations. It gets even worse if we want to find great grandparents: It gets even worse if we want to find great grandparents: -
mothersPaternalGrandfather :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +
+                                                                                                                            mothersPaternalGrandfather :: Sheep -> Maybe Sheep
mothersPaternalGrandfather s = case (mother s) of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          mothersPaternalGrandfather s = case (mother s) of
-                                                                            Nothing -> Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            Nothing -> Nothing
-                                                                            Just m  -> case (father m) of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            Just m  -> case (father m) of
-                                                                            Nothing -> Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            Nothing -> Nothing
-                                                                            Just gf -> father gf
+ Just gf -> father gf - Aside from being ugly, unclear, and difficult to maintain, this is just too much work. It is clear that a Nothing value at any point in the computation will cause Nothing to be the final result, and it would be much nicer to implement this notion once in a single place and remove all of the explicit case testing scattered all over the code. This will make the code easier to write, easier to read and easier to change. So good programming style would have us create a combinator that captures the behavior we want: + + Aside from being ugly, unclear, and difficult to maintain, this is just too much work. It is clear that a Nothing value at any point in the computation will cause Nothing to be the final result, and it would be much nicer to implement this notion once in a single place and remove all of the explicit case testing scattered all over the code. This will make the code easier to write, easier to read and easier to change. So good programming style would have us create a combinator that captures the behavior we want: Code available in [[../examples/example1.hs|example1.hs]] Code available in [[../examples/example1.hs|example1.hs]] -
-- comb is a combinator for sequencing operations that return Maybe                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +
-                                                                            comb :: Maybe a -> (a -> Maybe b) -> Maybe b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            -- comb is a combinator for sequencing operations that return Maybe
+                                                                                                                            comb :: Maybe a -> (a -> Maybe b) -> Maybe b
comb Nothing  _ = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  comb Nothing  _ = Nothing
comb (Just x) f = f x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      comb (Just x) f = f x

-- now we can use `comb` to build complicated sequences                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- now we can use `comb` to build complicated sequences
-                                                                            mothersPaternalGrandfather :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            mothersPaternalGrandfather :: Sheep -> Maybe Sheep
-                                                                            mothersPaternalGrandfather s = (Just s) `comb` mother `comb` father `comb` father
Prev: [[introduction.html|Introduction]]TOC: [[index.html|Contents]]Next: [[class.html|Doing it with class]]
+ - + - + - + - + - + - + - + Doing it with class Doing it with class - - -
-                                                                            (>>=)  :: m a -> (a -> m b) -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            class Monad m where
-                                                                            return :: a -> m a
-                                                                            Nothing  >>= f = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            instance Monad Maybe where
-                                                                            (Just x) >>= f = f x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            Nothing  >>= f = Nothing
-                                                                            return         = Just
+ (Just x) >>= f = f x - Once we have defined Maybe as an instance of the Monad class, we can use the standard monad operators to build the complex computations: + return = Just + + Once we have defined Maybe as an instance of the Monad class, we can use the standard monad operators to build the complex computations: -
-- we can use monadic operations to build complicated sequences                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +
-                                                                            maternalGrandfather :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            -- we can use monadic operations to build complicated sequences
-                                                                            maternalGrandfather s = (return s) >>= mother >>= father                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            maternalGrandfather :: Sheep -> Maybe Sheep
+                                                                                                                            maternalGrandfather s = (return s) >>= mother >>= father

-                                                                            fathersMaternalGrandmother :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            fathersMaternalGrandmother :: Sheep -> Maybe Sheep
-                                                                            fathersMaternalGrandmother s = (return s) >>= father >>= mother >>= mother
doSomething :: (Monad m) => a -> m b
+ + doSomething :: (Monad m) => a -> m b + is much more flexible than one of the type is much more flexible than one of the type -
doSomething :: a -> Maybe b
-- we can also use do-notation to build complicated sequences                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +
-                                                                            mothersPaternalGrandfather :: Sheep -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            -- we can also use do-notation to build complicated sequences
-                                                                            mothersPaternalGrandfather s = do m  <- mother s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            mothersPaternalGrandfather :: Sheep -> Maybe Sheep
-                                                                            gf <- father m                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            mothersPaternalGrandfather s = do m  <- mother s
-                                                                            father gf
+ gf <- father m - Compare this to fathersMaternalGrandmother written above without using do notation. + father gf + + Compare this to fathersMaternalGrandmother written above without using do notation. The do block shown above is written using the layout rule to define the extent of the block. Haskell also allows you to use braces and semicolons when defining a do block: The do block shown above is written using the layout rule to define the extent of the block. Haskell also allows you to use braces and semicolons when defining a do block: -
mothersPaternalGrandfather s = do { m <- mother s; gf <- father m; father gf }
expr1 >>= \x ->
+ - and every expression without a variable assignment, expr2 becomes + expr1 >>= \x -> + + and every expression without a variable assignment, expr2 becomes -
expr2 >>= \_ ->
+ - All do blocks must end with a monadic expression, and a let clause is allowed at the beginning of a do block (but let clauses in do blocks do not use the "in" keyword). The definition of mothersPaternalGrandfather above would be translated to: + expr2 >>= \_ -> + + All do blocks must end with a monadic expression, and a let clause is allowed at the beginning of a do block (but let clauses in do blocks do not use the "in" keyword). The definition of mothersPaternalGrandfather above would be translated to: -
mothersPaternalGrandfather s = mother s >>= \m ->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +
-                                                                            father m >>= \gf ->                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            mothersPaternalGrandfather s = mother s >>= \m ->
-                                                                            father gf
+ - + - + - + - + - + - + - + The monad laws The monad laws - - -
Prev: [[class.html|Doing it with class]]TOC: [[index.html|Contents]]Next: [[exercises.html|Exercises]]
fail s = error s
+ - You do not need to change this for your monad unless you want to provide different behavior for failure or to incorporate failure into the computational strategy of your monad. The Maybe monad, for instance, defines fail as: + fail s = error s + + You do not need to change this for your monad unless you want to provide different behavior for failure or to incorporate failure into the computational strategy of your monad. The Maybe monad, for instance, defines fail as: -
fail _ = Nothing
+ - so that fail returns an instance of the Maybe monad with meaningful behavior when it is bound with other functions in the Maybe monad. + fail _ = Nothing + + so that fail returns an instance of the Maybe monad with meaningful behavior when it is bound with other functions in the Maybe monad. - The fail function is not a required part of the mathematical definition of a monad, but it is included in the standard Monad class definition because of the role it plays in Haskell's do notation. The fail function is called whenever a pattern matching failure occurs in a do block: + The fail function is not a required part of the mathematical definition of a monad, but it is included in the standard Monad class definition because of the role it plays in Haskell's do notation. The fail function is called whenever a pattern matching failure occurs in a do block: -
fn :: Int -> Maybe [Int]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +
+                                                                                                                            fn :: Int -> Maybe [Int]
fn idx = do let l = [Just [1,2,3], Nothing, Just [], Just [7..20]]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         fn idx = do let l = [Just [1,2,3], Nothing, Just [], Just [7..20]]
-                                                                            (x:xs) <- l!!idx   -- a pattern match failure will call "fail"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            (x:xs) <- l!!idx   -- a pattern match failure will call "fail"
-                                                                            return xs
+ return xs - So in the code above, fn 0 has the value Just [2,3], but fn 1 and fn 2 both have the value Nothing. + + So in the code above, fn 0 has the value Just [2,3], but fn 1 and fn 2 both have the value Nothing. - The >> function is a convenience operator that is used to bind a monadic computation that does not require input from the previous computation in the sequence. It is defined in terms of >>=: + The >> function is a convenience operator that is used to bind a monadic computation that does not require input from the previous computation in the sequence. It is defined in terms of >>=: -
(>>) :: m a -> m b -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +
-                                                                            m >> k = m >>= (\_ -> k)
mzero :: m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               mzero :: m a
-                                                                            mplus :: m a -> m a -> m a
+ mplus :: m a -> m a -> m a - Continuing to use the Maybe monad as an example, we see that the Maybe monad is an instance of MonadPlus: + + Continuing to use the Maybe monad as an example, we see that the Maybe monad is an instance of MonadPlus: -
mzero             = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                mzero             = Nothing
Nothing `mplus` x = x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Nothing `mplus` x = x
-                                                                            x `mplus` _       = x
Prev: [[class.html|Doing it with class]]TOC: [[index.html|Contents]]Next: [[exercises.html|Exercises]]
+ - + - + - + - + - + - + - + Exercises Exercises - - -
Prev: [[exercises.html|Exercises]]TOC: [[index.html|Contents]]Next: [[introII.html|Part II - Introduction]]
-                                                                            (>>=)  :: m a -> (a -> m b) -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            class  Monad m  where
-                                                                            (>>)   :: m a -> m b -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            (>>=)  :: m a -> (a -> m b) -> m b
-                                                                            return :: a -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            (>>)   :: m a -> m b -> m b
-                                                                            fail   :: String -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            return :: a -> m a
+                                                                                                                            fail   :: String -> m a

-- Minimal complete definition:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- Minimal complete definition:
-                                                                            --      (>>=), return                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            --      (>>=), return
-                                                                            m >> k  =  m >>= \_ -> k                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            m >> k  =  m >>= \_ -> k
-                                                                            fail s  = error s
+ fail s = error s + === The sequencing functions === === The sequencing functions === - The sequence function takes a list of monadic computations, executes each one in turn and returns a list of the results. If any of the computations fail, then the whole function fails: + The sequence function takes a list of monadic computations, executes each one in turn and returns a list of the results. If any of the computations fail, then the whole function fails: -
sequence :: Monad m => [m a] -> m [a]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +
+                                                                                                                            sequence :: Monad m => [m a] -> m [a]
sequence = foldr mcons (return [])                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         sequence = foldr mcons (return [])
-                                                                            where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
+ where mcons p q = p >>= \x -> q >>= \y -> return (x:y) - The sequence_ function (notice the underscore) has the same behavior as sequence but does not return a list of results. It is useful when only the side-effects of the monadic computations are important. + + The sequence_ function (notice the underscore) has the same behavior as sequence but does not return a list of results. It is useful when only the side-effects of the monadic computations are important. -
sequence_ :: Monad m => [m a] -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +
-                                                                            sequence_ = foldr (>>) (return ())
+ sequence_ :: Monad m => [m a] -> m () + sequence_ = foldr (>>) (return ()) + === The mapping functions === === The mapping functions === - The mapM function maps a monadic computation over a list of values and returns a list of the results. It is defined in terms of the list map function and the sequence function above: + The mapM function maps a monadic computation over a list of values and returns a list of the results. It is defined in terms of the list map function and the sequence function above: -
mapM :: Monad m => (a -> m b) -> [a] -> m [b]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +
-                                                                            mapM f as = sequence (map f as)
+ mapM :: Monad m => (a -> m b) -> [a] -> m [b] - There is also a version with an underscore, mapM_ which is defined using sequence_. mapM_ operates the same as mapM, but it doesn't return the list of values. It is useful when only the side-effects of the monadic computation are important. + mapM f as = sequence (map f as) + + There is also a version with an underscore, mapM_ which is defined using sequence_. mapM_ operates the same as mapM, but it doesn't return the list of values. It is useful when only the side-effects of the monadic computation are important. -
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +
-                                                                            mapM_ f as = sequence_ (map f as)
+ mapM_ :: Monad m => (a -> m b) -> [a] -> m () - As a simple example of the use the mapping functions, a putString function for the IO monad could be defined as: + mapM_ f as = sequence_ (map f as) + + As a simple example of the use the mapping functions, a putString function for the IO monad could be defined as: -
putString :: [Char] -> IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +
-                                                                            putString s = mapM_ putChar s
+ putString :: [Char] -> IO () - mapM can be used within a do block in a manner similar to the way the map function is normally used on lists. This is a common pattern with monads — a version of a function for use within a monad (i.e., intended for binding) will have a signature similar to the non-monadic version but the function outputs will be within the monad: + putString s = mapM_ putChar s + + mapM can be used within a do block in a manner similar to the way the map function is normally used on lists. This is a common pattern with monads — a version of a function for use within a monad (i.e., intended for binding) will have a signature similar to the non-monadic version but the function outputs will be within the monad: -
-                                                                            map  ::            (a -> b)   -> [a] -> [b]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            -- compare the non-monadic and monadic signatures
-                                                                            mapM :: Monad m => (a -> m b) -> [a] -> m [b]
+ map :: (a -> b) -> [a] -> [b] - === The reverse binder function (=<<) === + mapM :: Monad m => (a -> m b) -> [a] -> m [b] + + === The reverse binder function (=<<) === - The prelude also defines a binding function that takes it arguments in the opposite order to the standard binding function. Since the standard binding function is called ">>=", the reverse binding function is called "=<<". It is useful in circumstances where the binding operator is used as a higher-order term and it is more convenient to have the arguments in the reversed order. Its definition is simply: + The prelude also defines a binding function that takes it arguments in the opposite order to the standard binding function. Since the standard binding function is called ">>=", the reverse binding function is called "=<<". It is useful in circumstances where the binding operator is used as a higher-order term and it is more convenient to have the arguments in the reversed order. Its definition is simply: -
(=<<) :: Monad m => (a -> m b) -> m a -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
-                                                                            f =<< x = x >>= f
mzero :: m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               mzero :: m a
-                                                                            mplus :: m a -> m a -> m a
+ mplus :: m a -> m a -> m a + === Monadic versions of list functions === === Monadic versions of list functions === - Several functions are provided which generalize standard list-processing functions to monads. The mapM functions are exported in the standard prelude and were described above. + Several functions are provided which generalize standard list-processing functions to monads. The mapM functions are exported in the standard prelude and were described above. - foldM is a monadic version of foldl in which monadic computations built from a list are bound left-to-right. The definition is: + foldM is a monadic version of foldl in which monadic computations built from a list are bound left-to-right. The definition is: -
foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +
+                                                                                                                            foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM f a []     = return a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                foldM f a []     = return a
-                                                                            foldM f a (x:xs) = f a x >>= \y -> foldM f y xs
+ foldM f a (x:xs) = f a x >>= \y -> foldM f y xs - but it is easier to understand the operation of foldM if you consider its effect in terms of a do block: + + but it is easier to understand the operation of foldM if you consider its effect in terms of a do block: -
-- this is not valid Haskell code, it is just for illustration                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
-                                                                            foldM f a1 [x1,x2,...,xn] = do a2 <- f a1 x1                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            -- this is not valid Haskell code, it is just for illustration
-                                                                            a3 <- f a2 x2                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            foldM f a1 [x1,x2,...,xn] = do a2 <- f a1 x1
+                                                                                                                            a3 <- f a2 x2
...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ...
-                                                                            f an xn
+ f an xn - Right-to-left binding is achieved by reversing the input list before calling foldM. + + Right-to-left binding is achieved by reversing the input list before calling foldM. - We can use foldM to create a more poweful query function in our sheep cloning example: + We can use foldM to create a more poweful query function in our sheep cloning example: Code available in [[../examples/example3.hs|example3.hs]] Code available in [[../examples/example3.hs|example3.hs]] -
-- traceFamily is a generic function to find an ancestor                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
-                                                                            traceFamily :: Sheep -> [ (Sheep -> Maybe Sheep) ] -> Maybe Sheep                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            -- traceFamily is a generic function to find an ancestor
+                                                                                                                            traceFamily :: Sheep -> [ (Sheep -> Maybe Sheep) ] -> Maybe Sheep
traceFamily s l = foldM getParent s l                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      traceFamily s l = foldM getParent s l
where getParent s f = f s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  where getParent s f = f s
Line 626:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Line 529:
-- we can define complex queries using traceFamily in an easy, clear way                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- we can define complex queries using traceFamily in an easy, clear way
mothersPaternalGrandfather s = traceFamily s [mother, father, father]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      mothersPaternalGrandfather s = traceFamily s [mother, father, father]
-                                                                            paternalGrandmother s = traceFamily s [father, mother]
+ paternalGrandmother s = traceFamily s [father, mother] - The traceFamily function uses foldM to create a simple way to trace back in the family tree to any depth and in any pattern. In fact, it is probably clearer to write "traceFamily s [father, mother]" than it is to use the paternalGrandmother function! + + The traceFamily function uses foldM to create a simple way to trace back in the family tree to any depth and in any pattern. In fact, it is probably clearer to write "traceFamily s [father, mother]" than it is to use the paternalGrandmother function! - A more typical use of foldM is within a do block: + A more typical use of foldM is within a do block: Code available in [[../examples/example4.hs|example4.hs]] Code available in [[../examples/example4.hs|example4.hs]] -
-- a Dict is just a finite map from strings to strings                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            -- a Dict is just a finite map from strings to strings
type Dict = FiniteMap String String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        type Dict = FiniteMap String String

-- this an auxilliary function used with foldl                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             -- this an auxilliary function used with foldl
-                                                                            addEntry :: Dict -> Entry -> Dict                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            addEntry :: Dict -> Entry -> Dict

-- this is an auxiliiary function used with foldM inside the IO monad                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- this is an auxiliiary function used with foldM inside the IO monad
-                                                                            addDataFromFile :: Dict -> Handle -> IO Dict                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            addDataFromFile :: Dict -> Handle -> IO Dict
-                                                                            addDataFromFile dict hdl = do contents <- hGetContents hdl                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            addDataFromFile dict hdl = do contents <- hGetContents hdl
-                                                                            entries  <- return (map read (lines contents))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            entries  <- return (map read (lines contents))

Line 649:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Line 554:
-- command line and then prints it out as an association list                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- command line and then prints it out as an association list
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do files   <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            main = do files   <- getArgs
-                                                                            handles <- mapM openForReading files                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            handles <- mapM openForReading files
-                                                                            dict    <- foldM addDataFromFile emptyFM handles                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            dict    <- foldM addDataFromFile emptyFM handles
-                                                                            print (fmToList dict)
+ print (fmToList dict) - The filterM function works like the list filter function inside of a monad. It takes a predicate function which returns a Boolean value in the monad and a list of values. It returns, inside the monad, a list of those values for which the predicate was True. + + The filterM function works like the list filter function inside of a monad. It takes a predicate function which returns a Boolean value in the monad and a list of values. It returns, inside the monad, a list of those values for which the predicate was True. -
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +
+                                                                                                                            filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
filterM p []     = return []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               filterM p []     = return []
-                                                                            filterM p (x:xs) = do b  <- p x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            filterM p (x:xs) = do b  <- p x
-                                                                            ys <- filterM p xs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            ys <- filterM p xs
-                                                                            return (if b then (x:ys) else ys)
+ return (if b then (x:ys) else ys) - Here is an example showing how filterM can be used within the IO monad to select only the directories from a list: + + Here is an example showing how filterM can be used within the IO monad to select only the directories from a list: Code available in [[../examples/example5.hs|example5.hs]] Code available in [[../examples/example5.hs|example5.hs]] -
import Directory                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           import Directory
import System                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              import System

-                                                                            -- NOTE: doesDirectoryExist has type FilePath -> IO Bool                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            -- NOTE: doesDirectoryExist has type FilePath -> IO Bool

-- this program prints only the directories named on the command line                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- this program prints only the directories named on the command line
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do names <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            main = do names <- getArgs
-                                                                            dirs  <- filterM doesDirectoryExist names                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            dirs  <- filterM doesDirectoryExist names
-                                                                            mapM_ putStrLn dirs
+ mapM_ putStrLn dirs - zipWithM is a monadic version of the zipWith function on lists. zipWithM_ behaves the same but discards the output of the function. It is useful when only the side-effects of the monadic computation matter. + + zipWithM is a monadic version of the zipWith function on lists. zipWithM_ behaves the same but discards the output of the function. It is useful when only the side-effects of the monadic computation matter. -
zipWithM ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            zipWithM ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM f xs ys = sequence (zipWith f xs ys)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              zipWithM f xs ys = sequence (zipWith f xs ys)

-                                                                            zipWithM_ ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            zipWithM_ ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-                                                                            zipWithM_ f xs ys = sequence_ (zipWith f xs ys)
+ zipWithM_ f xs ys = sequence_ (zipWith f xs ys) + === Conditional monadic computations === === Conditional monadic computations === - There are two functions provided for conditionally executing monadic computations. The when function takes a boolean argument and a monadic computation with unit "()" type and performs the computation only when the boolean argument is True. The unless function does the same, except that it performs the computation ''unless'' the boolean argument is True. + There are two functions provided for conditionally executing monadic computations. The when function takes a boolean argument and a monadic computation with unit "()" type and performs the computation only when the boolean argument is True. The unless function does the same, except that it performs the computation ''unless'' the boolean argument is True. -
when :: (Monad m) => Bool -> m () -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
+                                                                                                                            when :: (Monad m) => Bool -> m () -> m ()
when p s = if p then s else return ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      when p s = if p then s else return ()

-                                                                            unless :: (Monad m) => Bool -> m () -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            unless :: (Monad m) => Bool -> m () -> m ()
-                                                                            unless p s = when (not p) s
liftM :: (Monad m) => (a -> b) -> (m a -> m b)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +
-                                                                            liftM f = \a -> do { a' <- a; return (f a') }
+ liftM :: (Monad m) => (a -> b) -> (m a -> m b) - Lifting operators are also provided for functions with more arguments. liftM2 lifts functions of two arguments: + liftM f = \a -> do { a' <- a; return (f a') } + + Lifting operators are also provided for functions with more arguments. liftM2 lifts functions of two arguments: -
liftM2 :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +
-                                                                            liftM2 f = \a b -> do { a' <- a; b' <- b; return (f a' b') }
+ liftM2 :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c) - The same pattern is applied to give the definitions to lift functions of more arguments. Functions up to liftM5 are defined in the Monad module. + liftM2 f = \a b -> do { a' <- a; b' <- b; return (f a' b') } + + The same pattern is applied to give the definitions to lift functions of more arguments. Functions up to liftM5 are defined in the Monad module. - To see how the lifting operators allow more concise code, consider a computation in the Maybe monad in which you want to use a function swapNames::String -> String. You could do: + To see how the lifting operators allow more concise code, consider a computation in the Maybe monad in which you want to use a function swapNames::String -> String. You could do: -
getName :: String -> Maybe String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +
-                                                                            getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            getName :: String -> Maybe String
-                                                                            tempName <- lookup name db                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")]
-                                                                            return (swapNames tempName)
+ tempName <- lookup name db - But making use of the liftM function, we can use liftM swapNames as a function of type Maybe String -> Maybe String: + return (swapNames tempName) + + But making use of the liftM function, we can use liftM swapNames as a function of type Maybe String -> Maybe String: Code available in [[../examples/example6.hs|example6.hs]] Code available in [[../examples/example6.hs|example6.hs]] -
getName :: String -> Maybe String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +
-                                                                            getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            getName :: String -> Maybe String
-                                                                            liftM swapNames (lookup name db)
+ getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")] + liftM swapNames (lookup name db) + The difference is even greater when lifting functions with more arguments. The difference is even greater when lifting functions with more arguments. - The lifting functions also enable very concise constructions using higher-order functions. To understand this example code, you might need to review the definition of the monad functions for the [[listmonad.html#definition|List monad]] (particularly >>=). Imagine how you might implement this function without lifting the operator: + The lifting functions also enable very concise constructions using higher-order functions. To understand this example code, you might need to review the definition of the monad functions for the [[listmonad.html#definition|List monad]] (particularly >>=). Imagine how you might implement this function without lifting the operator: Code available in [[../examples/example7.hs|example7.hs]] Code available in [[../examples/example7.hs|example7.hs]] -
-- allCombinations returns a list containing the result of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +
+                                                                                                                            -- allCombinations returns a list containing the result of
-- folding the binary operator through all combinations                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- folding the binary operator through all combinations
-- of elements of the given lists                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          -- of elements of the given lists
Line 731:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Line 654:
-- and allCombinations (*) [[0,1],[1,2],[3,5]] would be                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- and allCombinations (*) [[0,1],[1,2],[3,5]] would be
--   [0*1*3,0*1*5,0*2*3,0*2*5,1*1*3,1*1*5,1*2*3,1*2*5], or [0,0,0,0,3,5,6,10]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              --   [0*1*3,0*1*5,0*2*3,0*2*5,1*1*3,1*1*5,1*2*3,1*2*5], or [0,0,0,0,3,5,6,10]
-                                                                            allCombinations :: (a -> a -> a) -> [[a]] -> [a]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            allCombinations :: (a -> a -> a) -> [[a]] -> [a]
allCombinations fn []     = []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             allCombinations fn []     = []
-                                                                            allCombinations fn (l:ls) = foldl (liftM2 fn) l ls
+ allCombinations fn (l:ls) = foldl (liftM2 fn) l ls - There is a related function called ap that is sometimes more convenient to use than the lifting functions. ap is simply the function application operator (\$) lifted into the monad: + + There is a related function called ap that is sometimes more convenient to use than the lifting functions. ap is simply the function application operator (\$) lifted into the monad: -
ap :: (Monad m) => m (a -> b) -> m a -> m b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +
-                                                                            ap = liftM2 (\$)
+ ap :: (Monad m) => m (a -> b) -> m a -> m b - Note that liftM2 f x y is equivalent to return f `ap` x `ap` y, and so on for functions of more arguments. ap is useful when working with higher-order functions and monads. + ap = liftM2 (\$) + + Note that liftM2 f x y is equivalent to return f `ap` x `ap` y, and so on for functions of more arguments. ap is useful when working with higher-order functions and monads. - The effect of ap depends on the strategy of the monad in which it is used. So for example [(*2),(+3)] `ap` [0,1,2] is equal to [0,2,4,3,4,5] and (Just (*2)) `ap` (Just 3) is Just 6. Here is a simple example that shows how ap can be useful when doing higher-order computations: + The effect of ap depends on the strategy of the monad in which it is used. So for example [(*2),(+3)] `ap` [0,1,2] is equal to [0,2,4,3,4,5] and (Just (*2)) `ap` (Just 3) is Just 6. Here is a simple example that shows how ap can be useful when doing higher-order computations: Code available in [[../examples/example8.hs|example8.hs]] Code available in [[../examples/example8.hs|example8.hs]] -
-- lookup the commands and fold ap into the command list to                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +
+                                                                                                                            -- lookup the commands and fold ap into the command list to
-- compute a result.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- compute a result.
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do let fns  = [("double",(2*)),      ("halve",(`div`2)),                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            main = do let fns  = [("double",(2*)),      ("halve",(`div`2)),
-                                                                            ("square",(\x->x*x)), ("negate", negate),                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            ("square",(\x->x*x)), ("negate", negate),
-                                                                            ("incr",(+1)),        ("decr",(+(-1)))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            ("incr",(+1)),        ("decr",(+(-1)))
]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ]
-                                                                            args <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            args <- getArgs
cmds = map ((flip lookup) fns) (words (args!!1))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           cmds = map ((flip lookup) fns) (words (args!!1))
-                                                                            print \$ foldl (flip ap) (Just val) cmds
+ print \$ foldl (flip ap) (Just val) cmds - === Functions for use with MonadPlus === + + === Functions for use with MonadPlus === - There are two functions in the Monad module that are used with monads that have a zero and a plus. The first function is msum, which is analogous to the sum function on lists of integers. msum operates on lists of monadic values and folds the mplus operator into the list using the mzero element as the initial value: + There are two functions in the Monad module that are used with monads that have a zero and a plus. The first function is msum, which is analogous to the sum function on lists of integers. msum operates on lists of monadic values and folds the mplus operator into the list using the mzero element as the initial value: -
msum :: MonadPlus m => [m a] -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +
-                                                                            msum xs = foldr mplus mzero xs
+ msum :: MonadPlus m => [m a] -> m a - In the List monad, msum is equivalent to concat. In the Maybe monad, msum returns the first non-Nothing value from a list. Likewise, the behavior in other monads will depend on the exact nature of their mzero and mplus definitions. + msum xs = foldr mplus mzero xs + + In the List monad, msum is equivalent to concat. In the Maybe monad, msum returns the first non-Nothing value from a list. Likewise, the behavior in other monads will depend on the exact nature of their mzero and mplus definitions. - msum allows many recursive functions and folds to be expressed more concisely. In the Maybe monad, for example, we can write: + msum allows many recursive functions and folds to be expressed more concisely. In the Maybe monad, for example, we can write: Code available in [[../examples/example9.hs|example9.hs]] Code available in [[../examples/example9.hs|example9.hs]] -
type Variable = String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            type Variable = String
type Value = String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        type Value = String
type EnvironmentStack = [[(Variable,Value)]]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               type EnvironmentStack = [[(Variable,Value)]]
Line 773:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Line 704:
-- lookupVar retrieves a variable's value from the environment stack                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- lookupVar retrieves a variable's value from the environment stack
-- It uses msum in the Maybe monad to return the first non-Nothing value.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- It uses msum in the Maybe monad to return the first non-Nothing value.
-                                                                            lookupVar :: Variable -> EnvironmentStack -> Maybe Value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            lookupVar :: Variable -> EnvironmentStack -> Maybe Value
-                                                                            lookupVar var stack = msum \$ map (lookup var) stack
+ lookupVar var stack = msum \$ map (lookup var) stack + instead of: instead of: -
lookupVar :: Variable -> EnvironmentStack -> Maybe Value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
+                                                                                                                            lookupVar :: Variable -> EnvironmentStack -> Maybe Value
lookupVar var []     = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             lookupVar var []     = Nothing
lookupVar var (e:es) = let val = lookup var e                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              lookupVar var (e:es) = let val = lookup var e
-                                                                            in maybe (lookupVar var es) Just val
+ in maybe (lookupVar var es) Just val - The second function for use with monads with a zero and a plus is the guard function: + + The second function for use with monads with a zero and a plus is the guard function: -
guard :: MonadPlus m => Bool -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +
-                                                                            guard p = if p then return () else mzero
+ guard :: MonadPlus m => Bool -> m () - The trick to understanding this function is to recall the law for monads with zero and plus that states mzero >>= f == mzero. So, placing a guard function in a sequence of monadic operations will force any execution in which the guard is False to be mzero. This is similar to the way that guard predicates in a list comprehension cause values that fail the predicate to become []. + guard p = if p then return () else mzero + + The trick to understanding this function is to recall the law for monads with zero and plus that states mzero >>= f == mzero. So, placing a guard function in a sequence of monadic operations will force any execution in which the guard is False to be mzero. This is similar to the way that guard predicates in a list comprehension cause values that fail the predicate to become []. - Here is an example demonstrating the use of the guard function in the Maybe monad. + Here is an example demonstrating the use of the guard function in the Maybe monad. Code available in [[../examples/example10.hs|example10.hs]] Code available in [[../examples/example10.hs|example10.hs]] -
data Record = Rec {name::String, age::Int} deriving Show                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
+                                                                                                                            data Record = Rec {name::String, age::Int} deriving Show
type DB = [Record]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         type DB = [Record]

Line 799:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  Line 736:
-- clearer to simply use filter.  When the filter criteria are more complex,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- clearer to simply use filter.  When the filter criteria are more complex,
-- guard becomes more useful.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- guard becomes more useful.
-                                                                            getYoungerThan :: Int -> DB -> [Record]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            getYoungerThan :: Int -> DB -> [Record]
-                                                                            getYoungerThan limit db = mapMaybe (\r -> do { guard (age r < limit); return r }) db
Prev: [[exercises.html|Exercises]]TOC: [[index.html|Contents]]Next: [[introII.html|Part II - Introduction]]
+ - + - + - + - + - + - + - + Part II - Introduction Part II - Introduction - - -
- - - - - - - - - - ----- = Introduction = = Introduction = Line 844: Line 756:
Monad Monad Type of computation Type of computationCombination strategy for >>=Combination strategy for >>=
[[maybemonad.html|Maybe]] [[maybemonad.html|Maybe]] Computations which may not return a result Computations which may not return a resultNothing input gives Nothing output
+
Nothing input gives Nothing output
- Just x input uses x as input to the bound function.
Computations which can be interrupted and restarted Computations which can be interrupted and restarted The bound function is inserted into the continuation chain. The bound function is inserted into the continuation chain.
- + Line 856: Line 768: - + Just x input uses x as input to the bound function. Line 893: Line 805: - - - - - - ----- - - -
- - - - Line 911: Line 810: The Identity monad The Identity monad - - -
- - - - - - - = The Identity monad = = The Identity monad = - - * [[#overview|Overview]] - * [[#motivation|Motivation]] - * [[#definition|Definition]] - * [[#example|Example]] - - - ----- == Overview == == Overview == Line 940: Line 821: Binding strategy: Binding strategy: - The bound function is applied to the input value. Identity x >>= f == Identity (f x) + The bound function is applied to the input value. Identity x >>= f == Identity (f x) Useful for: Useful for: Line 960: Line 841: == Definition == == Definition == -
newtype Identity a = Identity { runIdentity :: a }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
+                                                                                                                            newtype Identity a = Identity { runIdentity :: a }

return a           = Identity a   -- i.e. return = id                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      return a           = Identity a   -- i.e. return = id
-                                                                            (Identity x) >>= f = f x          -- i.e. x >>= f = f x
-                                                                            type State s a = StateT s Identity a
+ -- derive the State monad using the StateT monad transformer - + type State s a = StateT s Identity a - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The Maybe monad The Maybe monad - - -
- - - - - - - = The Maybe monad = = The Maybe monad = - - * [[#overview|Overview]] - * [[#motivation|Motivation]] - * [[#definition|Definition]] - * [[#example|Example]] - - - ----- == Overview == == Overview == Line 1,012: Line 866: Computation type: Computation type: - Computations which may return Nothing + Computations which may return Nothing Binding strategy: Binding strategy: - Nothing values bypass the bound function, other values are used as inputs to the bound function. + Nothing values bypass the bound function, other values are used as inputs to the bound function. Useful for: Useful for: - Building computations from sequences of functions that may return Nothing. Complex database queries or dictionary lookups are good examples. + Building computations from sequences of functions that may return Nothing. Complex database queries or dictionary lookups are good examples. Zero and plus: Zero and plus: - Nothing is the zero. The plus operation returns the first non-Nothing value or Nothing is both inputs are Nothing. + Nothing is the zero. The plus operation returns the first non-Nothing value or Nothing is both inputs are Nothing. Example type: Example type: Line 1,032: Line 886: == Motivation == == Motivation == - The Maybe monad embodies the strategy of combining a chain of computations that may each return Nothing by ending the chain early if any step produces Nothing as output. It is useful when a computation entails a sequence of steps that depend on one another, and in which some steps may fail to return a value. + The Maybe monad embodies the strategy of combining a chain of computations that may each return Nothing by ending the chain early if any step produces Nothing as output. It is useful when a computation entails a sequence of steps that depend on one another, and in which some steps may fail to return a value. [[Image:info.png]] If you ever find yourself writing code like this:
[[Image:info.png]] If you ever find yourself writing code like this:
-
case ... of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +
-                                                                            Nothing -> Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            case ... of
-                                                                            Just x  -> case ... of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            Nothing -> Nothing
-                                                                            Nothing -> Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            Just x  -> case ... of
-                                                                            Just y  -> ...
+ Nothing -> Nothing - you should consider using the monadic properties of Maybe to improve the code. + Just y -> ... + + you should consider using the monadic properties of Maybe to improve the code. == Definition == == Definition == -
data Maybe a = Nothing | Just a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +
+                                                                                                                            data Maybe a = Nothing | Just a

return         = Just                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      return         = Just
fail           = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   fail           = Nothing
-                                                                            Nothing  >>= f = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            Nothing  >>= f = Nothing
-                                                                            (Just x) >>= f = f x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            (Just x) >>= f = f x

mzero             = Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                mzero             = Nothing
Nothing `mplus` x = x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      Nothing `mplus` x = x
-                                                                            x `mplus` _       = x
+ x `mplus` _ = x + == Example == == Example == Line 1,064: Line 922: Code available in [[../examples/example11.hs|example11.hs]] Code available in [[../examples/example11.hs|example11.hs]] -
data MailPref = HTML | Plain                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +
+                                                                                                                            data MailPref = HTML | Plain
data MailSystem = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      data MailSystem = ...

-                                                                            getMailPrefs :: MailSystem -> String -> Maybe MailPref                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            getMailPrefs :: MailSystem -> String -> Maybe MailPref
getMailPrefs sys name =                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    getMailPrefs sys name =
do let nameDB = fullNameDB sys                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             do let nameDB = fullNameDB sys
nickDB = nickNameDB sys                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    nickDB = nickNameDB sys
prefDB = prefsDB sys                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       prefDB = prefsDB sys
-                                                                            addr <- (lookup name nameDB) `mplus` (lookup name nickDB)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            addr <- (lookup name nameDB) `mplus` (lookup name nickDB)
+ lookup addr prefDB - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The Error monad The Error monad - - -
class Error a where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +
+                                                                                                                            class Error a where
noMsg :: a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 noMsg :: a
-                                                                            strMsg :: String -> a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            strMsg :: String -> a

-                                                                            class (Monad m) => MonadError e m | m -> e where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            class (Monad m) => MonadError e m | m -> e where
-                                                                            throwError :: e -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            throwError :: e -> m a
-                                                                            catchError :: m a -> (e -> m a) -> m a
+ catchError :: m a -> (e -> m a) -> m a - throwError is used within a monadic computation to begin exception processing. catchError provides a handler function to handle previous errors and return to normal execution. A common idiom is: + + throwError is used within a monadic computation to begin exception processing. catchError provides a handler function to handle previous errors and return to normal execution. A common idiom is: -
do { action1; action2; action3 } `catchError` handler
+ - where the action functions can call throwError. Note that handler and the do-block must have the same return type. + do { action1; action2; action3 } `catchError` handler + + where the action functions can call throwError. Note that handler and the do-block must have the same return type. - The definition of the Either e type constructor as an instance of the MonadError class is straightforward. Following convention, Left is used for error values and Right is used for non-error (right) values. + The definition of the Either e type constructor as an instance of the MonadError class is straightforward. Following convention, Left is used for error values and Right is used for non-error (right) values. -
instance MonadError (Either e) where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +
+                                                                                                                            instance MonadError (Either e) where
throwError = Left                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          throwError = Left
(Left e) `catchError` handler = handler e                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  (Left e) `catchError` handler = handler e
-                                                                            a        `catchError` _       = a
+ a `catchError` _ = a + == Example == == Example == - Here is an example that demonstrates the use of a custom Error data type with the ErrorMonad's throwError and catchError exception mechanism. The example attempts to parse hexadecimal numbers and throws an exception if an invalid character is encountered. We use a custom Error data type to record the location of the parse error. The exception is caught by a calling function and handled by printing an informative error message. + Here is an example that demonstrates the use of a custom Error data type with the ErrorMonad's throwError and catchError exception mechanism. The example attempts to parse hexadecimal numbers and throws an exception if an invalid character is encountered. We use a custom Error data type to record the location of the parse error. The exception is caught by a calling function and handled by printing an informative error message. Code available in [[../examples/example12.hs|example12.hs]] Code available in [[../examples/example12.hs|example12.hs]] -
-- This is the type of our parse error representation.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            -- This is the type of our parse error representation.
data ParseError = Err {location::Int, reason::String}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      data ParseError = Err {location::Int, reason::String}

-- We make it an instance of the Error class                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- We make it an instance of the Error class
instance Error ParseError where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            instance Error ParseError where
-                                                                            noMsg    = Err 0 "Parse Error"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            noMsg    = Err 0 "Parse Error"
strMsg s = Err 0 s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         strMsg s = Err 0 s

Line 1,183:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,019:
-- an Integer in the ParseMonad monad and throws an error on an                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- an Integer in the ParseMonad monad and throws an error on an
-- invalid character                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- invalid character
-                                                                            parseHexDigit :: Char -> Int -> ParseMonad Integer                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            parseHexDigit :: Char -> Int -> ParseMonad Integer
parseHexDigit c idx = if isHexDigit c then                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 parseHexDigit c idx = if isHexDigit c then
return (toInteger (digitToInt c))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          return (toInteger (digitToInt c))
else                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       else
-                                                                            throwError (Err idx ("Invalid character '" ++ [c] ++ "'"))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            throwError (Err idx ("Invalid character '" ++ [c] ++ "'"))

-- parseHex parses a string containing a hexadecimal number into                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           -- parseHex parses a string containing a hexadecimal number into
-- an Integer in the ParseMonad monad.  A parse error from parseHexDigit                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- an Integer in the ParseMonad monad.  A parse error from parseHexDigit
-- will cause an exceptional return from parseHex.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -- will cause an exceptional return from parseHex.
-                                                                            parseHex :: String -> ParseMonad Integer                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            parseHex :: String -> ParseMonad Integer
parseHex s = parseHex' s 0 1                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               parseHex s = parseHex' s 0 1
where parseHex' []      val _   = return val                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               where parseHex' []      val _   = return val
-                                                                            parseHex' (c:cs)  val idx = do d <- parseHexDigit c idx                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            parseHex' (c:cs)  val idx = do d <- parseHexDigit c idx
parseHex' cs ((val * 16) + d) (idx + 1)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    parseHex' cs ((val * 16) + d) (idx + 1)

-- toString converts an Integer into a String in the ParseMonad monad                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- toString converts an Integer into a String in the ParseMonad monad
-                                                                            toString :: Integer -> ParseMonad String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            toString :: Integer -> ParseMonad String
toString n = return \$ show n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               toString n = return \$ show n

Line 1,206:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,042:
-- number.  A parse error on the input String will generate a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- number.  A parse error on the input String will generate a
-- descriptive error message as the output String.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -- descriptive error message as the output String.
-                                                                            convert :: String -> String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            convert :: String -> String
-                                                                            convert s = let (Right str) = do {n <- parseHex s; toString n} `catchError` printError                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            convert s = let (Right str) = do {n <- parseHex s; toString n} `catchError` printError
in str                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     in str
-                                                                            where printError e = return \$ "At index " ++ (show (location e)) ++ ":" ++ (reason e)
+ where printError e = return \$ "At index " ++ (show (location e)) ++ ":" ++ (reason e) - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The List monad The List monad - - -
- - - - - - - = The List monad = = The List monad = - - * [[#overview|Overview]] - * [[#motivation|Motivation]] - * [[#definition|Definition]] - * [[#example|Example]] - - - ----- == Overview == == Overview == Line 1,261: Line 1,067: Zero and plus: Zero and plus: - [] is the zero and ++ is the plus operation. + [] is the zero and ++ is the plus operation. Example type: Example type: - [a] + [a] == Motivation == == Motivation == Line 1,273: Line 1,079: == Definition == == Definition == -
-                                                                            m >>= f  = concatMap f m                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            instance Monad [] where
+                                                                                                                            m >>= f  = concatMap f m
return x = [x]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             return x = [x]
fail s   = []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              fail s   = []
Line 1,280:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,087:
mzero = []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 mzero = []
-                                                                            mplus = (++)
+ mplus = (++) + == Example == == Example == Line 1,287: Line 1,095: Code available in [[../examples/example13.hs|example13.hs]] Code available in [[../examples/example13.hs|example13.hs]] -
-- we can parse three different types of terms                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
+                                                                                                                            -- we can parse three different types of terms
data Parsed = Digit Integer | Hex Integer | Word String deriving Show                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      data Parsed = Digit Integer | Hex Integer | Word String deriving Show

-- attempts to add a character to the parsed representation of a hex digit                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- attempts to add a character to the parsed representation of a hex digit
-                                                                            parseHexDigit :: Parsed -> Char -> [Parsed]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            parseHexDigit :: Parsed -> Char -> [Parsed]
parseHexDigit (Hex n) c = if isHexDigit c then                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             parseHexDigit (Hex n) c = if isHexDigit c then
return (Hex ((n*16) + (toInteger (digitToInt c))))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         return (Hex ((n*16) + (toInteger (digitToInt c))))
Line 1,299:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,108:

-- attempts to add a character to the parsed representation of a decimal digit                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             -- attempts to add a character to the parsed representation of a decimal digit
-                                                                            parseDigit :: Parsed -> Char -> [Parsed]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            parseDigit :: Parsed -> Char -> [Parsed]
parseDigit (Digit n) c = if isDigit c then                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 parseDigit (Digit n) c = if isDigit c then
return (Digit ((n*10) + (toInteger (digitToInt c))))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       return (Digit ((n*10) + (toInteger (digitToInt c))))
Line 1,307:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,116:

-- attempts to add a character to the parsed representation of a word                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- attempts to add a character to the parsed representation of a word
-                                                                            parseWord :: Parsed -> Char -> [Parsed]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            parseWord :: Parsed -> Char -> [Parsed]
parseWord (Word s) c = if isAlpha c then                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   parseWord (Word s) c = if isAlpha c then
return (Word (s ++ [c]))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return (Word (s ++ [c]))
Line 1,316:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,125:
-- tries to parse the digit as a hex value, a decimal value and a word                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     -- tries to parse the digit as a hex value, a decimal value and a word
-- the result is a list of possible parses                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- the result is a list of possible parses
-                                                                            parse :: Parsed -> Char -> [Parsed]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            parse :: Parsed -> Char -> [Parsed]
parse p c = (parseHexDigit p c) `mplus` (parseDigit p c) `mplus` (parseWord p c)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           parse p c = (parseHexDigit p c) `mplus` (parseDigit p c) `mplus` (parseWord p c)

-- parse an entire String and return a list of the possible parsed values                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- parse an entire String and return a list of the possible parsed values
-                                                                            parseArg :: String -> [Parsed]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            parseArg :: String -> [Parsed]
-                                                                            parseArg s = do init <- (return (Hex 0)) `mplus` (return (Digit 0)) `mplus` (return (Word ""))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            parseArg s = do init <- (return (Hex 0)) `mplus` (return (Digit 0)) `mplus` (return (Word ""))
-                                                                            foldM parse init s
+ foldM parse init s - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The IO monad The IO monad - - -
-                                                                            return a = ...   -- function from a -> IO a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            instance Monad IO where
-                                                                            m >>= k  = ...   -- executes the I/O action m and binds the value to k's input                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            return a = ...   -- function from a -> IO a
+                                                                                                                            m >>= k  = ...   -- executes the I/O action m and binds the value to k's input
fail s   = ioError (userError s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           fail s   = ioError (userError s)

data IOError = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         data IOError = ...

-                                                                            ioError :: IOError -> IO a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            ioError :: IOError -> IO a
ioError = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ioError = ...

-                                                                            userError :: String -> IOError                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            userError :: String -> IOError
userError = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            userError = ...

-                                                                            catch :: IO a -> (IOError -> IO a) -> IO a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            catch :: IO a -> (IOError -> IO a) -> IO a
catch = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                catch = ...

-                                                                            try :: IO a -> IO (Either IOError a)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            try :: IO a -> IO (Either IOError a)
-                                                                            try f = catch (do r <- f                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            try f = catch (do r <- f
return (Right r))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          return (Right r))
-                                                                            (return . Left)
+ (return . Left) - The IO monad is incorporated into the Monad Template Library framework as an instance of the MonadError class. + + The IO monad is incorporated into the Monad Template Library framework as an instance of the MonadError class. -
instance Error IOError where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +
+                                                                                                                            instance Error IOError where
...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ...

throwError = ioError                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       throwError = ioError
-                                                                            catchError = catch
+ catchError = catch - The IO module exports a convenience function called try that executes an I/O action and returns Right result if the action succeeded or Left IOError if an I/O error was caught. + + The IO module exports a convenience function called try that executes an I/O action and returns Right result if the action succeeded or Left IOError if an I/O error was caught. == Example == == Example == - This example shows a partial implementation of the "tr" command that copies the standard input stream to the standard output stream with character translations controlled by command-line arguments. It demonstrates the use of the exception handling mechanisms of the MonadError class with the IO monad. + This example shows a partial implementation of the "tr" command that copies the standard input stream to the standard output stream with character translations controlled by command-line arguments. It demonstrates the use of the exception handling mechanisms of the MonadError class with the IO monad. Code available in [[../examples/example14.hs|example14.hs]] Code available in [[../examples/example14.hs|example14.hs]] -
import System                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              import System
import IO                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  import IO
Line 1,438:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,222:

-- translate char in set1 to corresponding char in set2                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- translate char in set1 to corresponding char in set2
-                                                                            translate :: String -> String -> Char -> Char                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            translate :: String -> String -> Char -> Char
translate []     _      c = c                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              translate []     _      c = c
translate (x:xs) []     c = if x == c then ' ' else translate xs []  c                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     translate (x:xs) []     c = if x == c then ' ' else translate xs []  c
Line 1,445:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,229:

-- translate an entire string                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- translate an entire string
-                                                                            translateString :: String -> String -> String -> String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            translateString :: String -> String -> String -> String
translateString set1 set2 str = map (translate set1 set2) str                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              translateString set1 set2 str = map (translate set1 set2) str

-                                                                            usage :: IOError -> IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            usage :: IOError -> IO ()
-                                                                            usage e = do putStrLn "Usage: ex14 set1 set2"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            usage e = do putStrLn "Usage: ex14 set1 set2"
-                                                                            putStrLn "Translates characters in set1 on stdin to the corresponding"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            putStrLn "Translates characters in set1 on stdin to the corresponding"
-                                                                            putStrLn "characters from set2 and writes the translation to stdout."                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            putStrLn "characters from set2 and writes the translation to stdout."

-- translates stdin to stdout based on commandline arguments                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- translates stdin to stdout based on commandline arguments
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = (do [set1,set2] <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            main = (do [set1,set2] <- getArgs
-                                                                            contents    <- hGetContents stdin                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            contents    <- hGetContents stdin
putStr \$ translateString set1 set2 contents)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               putStr \$ translateString set1 set2 contents)
-                                                                            `catchError` usage
+ `catchError` usage - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The State monad The State monad - - -
- - - - - - - = The State monad = = The State monad = - - * [[#overview|Overview]] - * [[#motivation|Motivation]] - * [[#definition|Definition]] - * [[#example|Example]] - - - ----- == Overview == == Overview == Line 1,520: Line 1,274: A pure functional language cannot update values in place because it violates referential transparency. A common idiom to simulate such stateful computations is to "thread" a state parameter through a sequence of functions: A pure functional language cannot update values in place because it violates referential transparency. A common idiom to simulate such stateful computations is to "thread" a state parameter through a sequence of functions: -
data MyType = MT Int Bool Char Int deriving Show                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            data MyType = MT Int Bool Char Int deriving Show

-                                                                            makeRandomValue :: StdGen -> (MyType, StdGen)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            makeRandomValue :: StdGen -> (MyType, StdGen)
makeRandomValue g = let (n,g1) = randomR (1,100) g                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         makeRandomValue g = let (n,g1) = randomR (1,100) g
(b,g2) = random g1                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         (b,g2) = random g1
(c,g3) = randomR ('a','z') g2                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              (c,g3) = randomR ('a','z') g2
(m,g4) = randomR (-n,n) g3                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 (m,g4) = randomR (-n,n) g3
-                                                                            in (MT n b c m, g4)
+ in (MT n b c m, g4) + This approach works, but such code can be error-prone, messy and difficult to maintain. The State monad hides the threading of the state parameter inside the binding operation, simultaneously making the code easier to write, easier to read and easier to modify. This approach works, but such code can be error-prone, messy and difficult to maintain. The State monad hides the threading of the state parameter inside the binding operation, simultaneously making the code easier to write, easier to read and easier to modify. Line 1,534: Line 1,290: The definition shown here uses multi-parameter type classes and funDeps, which are not standard Haskell 98. It is not necessary to fully understand these details to make use of the State monad. The definition shown here uses multi-parameter type classes and funDeps, which are not standard Haskell 98. It is not necessary to fully understand these details to make use of the State monad. -
newtype State s a = State { runState :: (s -> (a,s)) }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +
+                                                                                                                            newtype State s a = State { runState :: (s -> (a,s)) }

-                                                                            return a        = State \$ \s -> (a,s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            return a        = State \$ \s -> (a,s)
-                                                                            (State x) >>= f = State \$ \s -> let (v,s') = x s in runState (f v) s'
+ (State x) >>= f = State \$ \s -> let (v,s') = x s in runState (f v) s' - Values in the State monad are represented as transition functions from an initial state to a (value,newState) pair and a new type definition is provided to describe this construct: State s a is the type of a value of type a inside the State monad with state of type s. + + Values in the State monad are represented as transition functions from an initial state to a (value,newState) pair and a new type definition is provided to describe this construct: State s a is the type of a value of type a inside the State monad with state of type s. - The type constructor State s is an instance of the Monad class. The return function simply creates a state transition function which sets the value but leaves the state unchanged. The binding operator creates a state transition function that applies its right-hand argument to the value and new state from its left-hand argument. + The type constructor State s is an instance of the Monad class. The return function simply creates a state transition function which sets the value but leaves the state unchanged. The binding operator creates a state transition function that applies its right-hand argument to the value and new state from its left-hand argument. -
class MonadState m s | m -> s where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            class MonadState m s | m -> s where
get :: m s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 get :: m s
-                                                                            put :: s -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            put :: s -> m ()

instance MonadState (State s) s where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      instance MonadState (State s) s where
-                                                                            get   = State \$ \s -> (s,s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            get   = State \$ \s -> (s,s)
-                                                                            put s = State \$ \_ -> ((),s)
data MyType = MT Int Bool Char Int deriving Show                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            data MyType = MT Int Bool Char Int deriving Show

{- Using the State monad, we can define a function that returns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            {- Using the State monad, we can define a function that returns
Line 1,566:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,327:
the same time.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             the same time.
-}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -}
-                                                                            getAny :: (Random a) => State StdGen a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            getAny :: (Random a) => State StdGen a
-                                                                            getAny = do g      <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            getAny = do g      <- get
-                                                                            (x,g') <- return \$ random g                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            (x,g') <- return \$ random g
put g'                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     put g'
return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return x

-- similar to getAny, but it bounds the random value returned                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- similar to getAny, but it bounds the random value returned
-                                                                            getOne :: (Random a) => (a,a) -> State StdGen a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            getOne :: (Random a) => (a,a) -> State StdGen a
-                                                                            getOne bounds = do g      <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            getOne bounds = do g      <- get
-                                                                            (x,g') <- return \$ randomR bounds g                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            (x,g') <- return \$ randomR bounds g
put g'                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     put g'
return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return x
Line 1,583:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,344:
random generator states through the code.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  random generator states through the code.
-}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -}
-                                                                            makeRandomValueST :: StdGen -> (MyType, StdGen)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            makeRandomValueST :: StdGen -> (MyType, StdGen)
-                                                                            makeRandomValueST = runState (do n <- getOne (1,100)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            makeRandomValueST = runState (do n <- getOne (1,100)
-                                                                            b <- getAny                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            b <- getAny
-                                                                            c <- getOne ('a','z')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            c <- getOne ('a','z')
-                                                                            m <- getOne (-n,n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            m <- getOne (-n,n)
-                                                                            return (MT n b c m))
+ return (MT n b c m)) - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The Reader monad The Reader monad - - -
- - - - - - - = The Reader monad = = The Reader monad = - - * [[#overview|Overview]] - * [[#motivation|Motivation]] - * [[#definition|Definition]] - * [[#example|Example]] - - - ----- == Overview == == Overview == Line 1,656: Line 1,387: The definition shown here uses multi-parameter type classes and funDeps, which are not standard Haskell 98. It is not necessary to fully understand these details to make use of the Reader monad. The definition shown here uses multi-parameter type classes and funDeps, which are not standard Haskell 98. It is not necessary to fully understand these details to make use of the Reader monad. -

-                                                                            return a         = Reader \$ \e -> a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            return a         = Reader \$ \e -> a
-                                                                            (Reader r) >>= f = Reader \$ \e -> f (r e) e
-                                                                            local :: (e -> e) -> m a -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            local :: (e -> e) -> m a -> m a

-                                                                            local f c = Reader \$ \e -> runReader c (f e)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            local f c = Reader \$ \e -> runReader c (f e)

-- This the abstract syntax representation of a template                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
+                                                                                                                            -- This the abstract syntax representation of a template
--              Text       Variable     Quote        Include                   Compound                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    --              Text       Variable     Quote        Include                   Compound
data Template = T String | V Template | Q Template | I Template [Definition] | C [Template]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                data Template = T String | V Template | Q Template | I Template [Definition] | C [Template]
Line 1,694:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,430:

-- lookup a variable from the environment                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- lookup a variable from the environment
-                                                                            lookupVar :: String -> Environment -> Maybe String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            lookupVar :: String -> Environment -> Maybe String
lookupVar name env = lookup name (variables env)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           lookupVar name env = lookup name (variables env)

-- lookup a template from the environment                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- lookup a template from the environment
-                                                                            lookupTemplate :: String -> Environment -> Maybe Template                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            lookupTemplate :: String -> Environment -> Maybe Template
lookupTemplate name env = lookup name (templates env)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      lookupTemplate name env = lookup name (templates env)

-- add a list of resolved definitions to the environment                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- add a list of resolved definitions to the environment
-                                                                            addDefs :: [(String,String)] -> Environment -> Environment                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            addDefs :: [(String,String)] -> Environment -> Environment
addDefs defs env = env {variables = defs ++ (variables env)}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               addDefs defs env = env {variables = defs ++ (variables env)}

-- resolve a Definition and produce a (name,value) pair                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- resolve a Definition and produce a (name,value) pair
-                                                                            resolveDef :: Definition -> Reader Environment (String,String)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            resolveDef :: Definition -> Reader Environment (String,String)
-                                                                            resolveDef (D t d) = do name <- resolve t                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            resolveDef (D t d) = do name <- resolve t
-                                                                            value <- resolve d                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            value <- resolve d
return (name,value)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        return (name,value)

-- resolve a template into a string                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        -- resolve a template into a string
-                                                                            resolve :: Template -> Reader Environment (String)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            resolve :: Template -> Reader Environment (String)
resolve (T s)    = return s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                resolve (T s)    = return s
-                                                                            resolve (V t)    = do varName  <- resolve t                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            resolve (V t)    = do varName  <- resolve t
-                                                                            varValue <- asks (lookupVar varName)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            varValue <- asks (lookupVar varName)
-                                                                            return \$ maybe "" id varValue                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ maybe "" id varValue
-                                                                            resolve (Q t)    = do tmplName <- resolve t                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            resolve (Q t)    = do tmplName <- resolve t
-                                                                            body     <- asks (lookupTemplate tmplName)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            body     <- asks (lookupTemplate tmplName)
-                                                                            return \$ maybe "" show body                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            return \$ maybe "" show body
-                                                                            resolve (I t ds) = do tmplName <- resolve t                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            resolve (I t ds) = do tmplName <- resolve t
-                                                                            body     <- asks (lookupTemplate tmplName)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            body     <- asks (lookupTemplate tmplName)
case body of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               case body of
-                                                                            Just t' -> do defs <- mapM resolveDef ds                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            Just t' -> do defs <- mapM resolveDef ds
-                                                                            Nothing -> return ""                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            Nothing -> return ""
-                                                                            resolve (C ts)   = (liftM concat) (mapM resolve ts)
+ resolve (C ts) = (liftM concat) (mapM resolve ts) - To use the Reader monad to resolve a template t into a String, you simply need to do runReader (resolve t) env. + - + To use the Reader monad to resolve a template t into a String, you simply need to do runReader (resolve t) env. - + - ----- + - + - + -
+ - + - + - + - + - + - + - + The Writer monad The Writer monad - - -
newtype Writer w a = Writer { runWriter :: (a,w) }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
+                                                                                                                            newtype Writer w a = Writer { runWriter :: (a,w) }

-                                                                            instance (Monoid w) => Monad (Writer w) where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            instance (Monoid w) => Monad (Writer w) where
return a             = Writer (a,mempty)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return a             = Writer (a,mempty)
-                                                                            (Writer (a,w)) >>= f = let (a',w') = runWriter \$ f a in Writer (a',w `mappend` w')
+ (Writer (a,w)) >>= f = let (a',w') = runWriter \$ f a in Writer (a',w `mappend` w') - The Writer monad maintains a (value,log) pair, where the log type must be a monoid. The return function simply returns the value along with an empty log. Binding executes the bound function using the current value as input, and appends any log output to the existing log. + + The Writer monad maintains a (value,log) pair, where the log type must be a monoid. The return function simply returns the value along with an empty log. Binding executes the bound function using the current value as input, and appends any log output to the existing log. -
class (Monoid w, Monad m) => MonadWriter w m | m -> w where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +
-                                                                            pass   :: m (a,w -> w) -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            class (Monoid w, Monad m) => MonadWriter w m | m -> w where
-                                                                            listen :: m a -> m (a,w)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            pass   :: m (a,w -> w) -> m a
-                                                                            tell   :: w -> m ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            listen :: m a -> m (a,w)
+                                                                                                                            tell   :: w -> m ()

-                                                                            instance (Monoid w) => MonadWriter (Writer w) where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            instance (Monoid w) => MonadWriter (Writer w) where
pass   (Writer ((a,f),w)) = Writer (a,f w)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 pass   (Writer ((a,f),w)) = Writer (a,f w)
listen (Writer (a,w))     = Writer ((a,w),w)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               listen (Writer (a,w))     = Writer ((a,w),w)
tell   s                  = Writer ((),s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  tell   s                  = Writer ((),s)

-                                                                            listens :: (MonadWriter w m) => (w -> w) -> m a -> m (a,w)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            listens :: (MonadWriter w m) => (w -> w) -> m a -> m (a,w)
-                                                                            listens f m = do (a,w) <- m; return (a,f w)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            listens f m = do (a,w) <- m; return (a,f w)

-                                                                            censor :: (MonadWriter w m) => (w -> w) -> m a -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
-                                                                            censor f m = pass \$ do a <- m; return (a,f)
+ censor f m = pass \$ do a <- m; return (a,f) - The MonadWriter class provides a number of convenience functions for working with Writer monads. The simplest and most useful is tell, which adds one or more entries to the log. The listen function turns a Writer that returns a value a and produces output w into a Writer that produces a value (a,w) and still produces output w. This allows the computation to "listen" to the log output generated by a Writer. + + The MonadWriter class provides a number of convenience functions for working with Writer monads. The simplest and most useful is tell, which adds one or more entries to the log. The listen function turns a Writer that returns a value a and produces output w into a Writer that produces a value (a,w) and still produces output w. This allows the computation to "listen" to the log output generated by a Writer. - The pass function is slightly more complicated. It converts a Writer that produces a value (a,f) and output w into a Writer that produces a value a and output f w. This is somewhat cumbersome, so the helper function censor is normally used. The censor function takes a function and a Writer and produces a new Writer whose output is the same but whose log entry has been modified by the function. + The pass function is slightly more complicated. It converts a Writer that produces a value (a,f) and output w into a Writer that produces a value a and output f w. This is somewhat cumbersome, so the helper function censor is normally used. The censor function takes a function and a Writer and produces a new Writer whose output is the same but whose log entry has been modified by the function. - The listens function operates just like listen except that the log part of the value is modified by the supplied function. + The listens function operates just like listen except that the log part of the value is modified by the supplied function. == Example == == Example == Line 1,842: Line 1,552: Code available in [[../examples/example17.hs|example17.hs]] Code available in [[../examples/example17.hs|example17.hs]] -
-- this is the format of our log entries                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
+                                                                                                                            -- this is the format of our log entries
data Entry = Log {count::Int, msg::String} deriving Eq                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     data Entry = Log {count::Int, msg::String} deriving Eq

-- add a message to the log                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -- add a message to the log
-                                                                            logMsg :: String -> Writer [Entry] ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            logMsg :: String -> Writer [Entry] ()
logMsg s = tell [Log 1 s]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  logMsg s = tell [Log 1 s]

-- this handles one packet                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- this handles one packet
-                                                                            filterOne :: [Rule] -> Packet -> Writer [Entry] (Maybe Packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            filterOne :: [Rule] -> Packet -> Writer [Entry] (Maybe Packet)
-                                                                            filterOne rules packet = do rule <- return (match rules packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            filterOne rules packet = do
-                                                                            case rule of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            rule <- return (match rules packet)
-                                                                            Nothing  -> do logMsg ("DROPPING UNMATCHED PACKET: " ++ (show packet))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            case rule of
-                                                                            return Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            Nothing  -> do
-                                                                            (Just r) -> do when (logIt r) (logMsg ("MATCH: " ++ (show r) ++ " <=> " ++ (show packet)))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            logMsg \$ "DROPPING UNMATCHED PACKET: " ++ (show packet)
-                                                                            case r of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            return Nothing
-                                                                            (Rule Accept _ _) -> return (Just packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            (Just r) -> do
-                                                                            (Rule Reject _ _) -> return Nothing
+ when (logIt r) \$ logMsg ("MATCH: " ++ (show r) ++ " <=> " ++ (show packet)) + case r of (Rule Accept _ _) -> return \$ Just packet + (Rule Reject _ _) -> return Nothing + That was pretty simple, but what if we want to merge duplicate consecutive log entries? None of the existing functions allow us to modify the output from previous stages of the computation, but we can use a "delayed logging" trick to only add a log entry only after we get a new entry that doesn't match the ones before it. That was pretty simple, but what if we want to merge duplicate consecutive log entries? None of the existing functions allow us to modify the output from previous stages of the computation, but we can use a "delayed logging" trick to only add a log entry only after we get a new entry that doesn't match the ones before it. Code available in [[../examples/example17.hs|example17.hs]] Code available in [[../examples/example17.hs|example17.hs]] -
-- merge identical entries at the end of the log                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            -- merge identical entries at the end of the log
-- This function uses [Entry] as both the log type and the result type.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- This function uses [Entry] as both the log type and the result type.
-- When two identical messages are merged, the result is just the message                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- When two identical messages are merged, the result is just the message
-- with an incremented count.  When two different messages are merged,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     -- with an incremented count.  When two different messages are merged,
-- the first message is logged and the second is returned as the result.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- the first message is logged and the second is returned as the result.
-                                                                            mergeEntries :: [Entry] -> [Entry] -> Writer [Entry] [Entry]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            mergeEntries :: [Entry] -> [Entry] -> Writer [Entry] [Entry]
mergeEntries []   x    = return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          mergeEntries []   x    = return x
mergeEntries x    []   = return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          mergeEntries x    []   = return x
Line 1,885:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,600:
-- log output is the result of folding the merge operator into the individual                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- log output is the result of folding the merge operator into the individual
-- log entries (using 'initial' as the initial log value).                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- log entries (using 'initial' as the initial log value).
-                                                                            groupSame :: (Monoid a) => a -> (a -> a -> Writer a a) -> [b] -> (b -> Writer a c) -> Writer a [c]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            groupSame :: (Monoid a) => a -> (a -> a -> Writer a a) -> [b] -> (b -> Writer a c) -> Writer a [c]
groupSame initial merge []     _  = do tell initial                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        groupSame initial merge []     _  = do tell initial
return []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  return []
-                                                                            groupSame initial merge (x:xs) fn = do (result,output) <- return (runWriter (fn x))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            groupSame initial merge (x:xs) fn = do (result,output) <- return (runWriter (fn x))
-                                                                            new             <- merge initial output                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            new             <- merge initial output
-                                                                            rest            <- groupSame new merge xs fn                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            rest            <- groupSame new merge xs fn
return (result:rest)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       return (result:rest)

-- this filters a list of packets, producing a filtered packet list and a log of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           -- this filters a list of packets, producing a filtered packet list and a log of
-- the activity in which consecutive messages are merged                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- the activity in which consecutive messages are merged
-                                                                            filterAll :: [Rule] -> [Packet] -> Writer [Entry] [Packet]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            filterAll :: [Rule] -> [Packet] -> Writer [Entry] [Packet]
-                                                                            filterAll rules packets = do tell [Log 1 "STARTING PACKET FILTER"]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            filterAll rules packets = do tell [Log 1 "STARTING PACKET FILTER"]
-                                                                            out <- groupSame [] mergeEntries packets (filterOne rules)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            out <- groupSame [] mergeEntries packets (filterOne rules)
-                                                                            tell [Log 1 "STOPPING PACKET FILTER"]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            tell [Log 1 "STOPPING PACKET FILTER"]
-                                                                            return (catMaybes out)
+ return (catMaybes out) - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + The Continuation monad The Continuation monad - - -
newtype Cont r a = Cont { runCont :: ((a -> r) -> r) } -- r is the final result type of the whole computation                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +
+                                                                                                                            newtype Cont r a = Cont { runCont :: ((a -> r) -> r) } -- r is the final result type of the whole computation

-                                                                            return a       = Cont \$ \k -> k a                       -- i.e. return a = \k -> k a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            return a       = Cont \$ \k -> k a                       -- i.e. return a = \k -> k a
-                                                                            (Cont c) >>= f = Cont \$ \k -> c (\a -> runCont (f a) k) -- i.e. c >>= f = \k -> c (\a -> f a k)
+ (Cont c) >>= f = Cont \$ \k -> c (\a -> runCont (f a) k) -- i.e. c >>= f = \k -> c (\a -> f a k) - The Continuation monad represents computations in continuation-passing style. Cont r a is a CPS computation that produces an intermediate result of type a within a CPS computation whose final result type is r. + + The Continuation monad represents computations in continuation-passing style. Cont r a is a CPS computation that produces an intermediate result of type a within a CPS computation whose final result type is r. - The return function simply creates a continuation which passes the value on. The >>= operator adds the bound function into the continuation chain. + The return function simply creates a continuation which passes the value on. The >>= operator adds the bound function into the continuation chain. -
-                                                                            callCC :: ((a -> m b) -> m a) -> m a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            class (Monad m) => MonadCont m where
+                                                                                                                            callCC :: ((a -> m b) -> m a) -> m a

-                                                                            callCC f = Cont \$ \k -> runCont (f (\a -> Cont \$ \_ -> k a)) k
+ callCC f = Cont \$ \k -> runCont (f (\a -> Cont \$ \_ -> k a)) k - The MonadCont class provides the callCC function, which provides an escape continuation mechanism for use with Continuation monads. Escape continuations allow you to abort the current computation and return a value immediately. They achieve a similar effect to throwError and catchError within an Error monad. + + The MonadCont class provides the callCC function, which provides an escape continuation mechanism for use with Continuation monads. Escape continuations allow you to abort the current computation and return a value immediately. They achieve a similar effect to throwError and catchError within an Error monad. - callCC calls a function with the current continuation as its argument (hence the name). The standard idiom used with callCC is to provide a lambda-expression to name the continuation. Then calling the named continuation anywhere within its scope will escape from the computation, even if it is many layers deep within nested computations. + callCC calls a function with the current continuation as its argument (hence the name). The standard idiom used with callCC is to provide a lambda-expression to name the continuation. Then calling the named continuation anywhere within its scope will escape from the computation, even if it is many layers deep within nested computations. - In addition to the escape mechanism provided by callCC, the Continuation monad can be used to implement other, more powerful continuation manipulations. These other mechanisms have fairly specialized uses, however — and abuse of them can easily create fiendishly obfuscated code — so they will not be covered here. + In addition to the escape mechanism provided by callCC, the Continuation monad can be used to implement other, more powerful continuation manipulations. These other mechanisms have fairly specialized uses, however — and abuse of them can easily create fiendishly obfuscated code — so they will not be covered here. == Example == == Example == Line 1,993: Line 1,682: Code available in [[../examples/example18.hs|example18.hs]] Code available in [[../examples/example18.hs|example18.hs]] -
{- We use the continuation monad to perform "escapes" from code blocks.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +
+                                                                                                                            {- We use the continuation monad to perform "escapes" from code blocks.
This function implements a complicated control structure to process                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        This function implements a complicated control structure to process
numbers:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   numbers:
Line 2,003:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 1,693:
200-19999       n                            digits of (n/2)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               200-19999       n                            digits of (n/2)
20000-1999999   (n/2) backwards              none                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          20000-1999999   (n/2) backwards              none
-                                                                            >= 2000000      sum of digits of (n/2)       digits of (n/2)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            >= 2000000      sum of digits of (n/2)       digits of (n/2)
-}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -}
-                                                                            fun :: Int -> String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            fun :: Int -> String
fun n = (`runCont` id) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                fun n = (`runCont` id) \$ do
-                                                                            str <- callCC \$ \exit1 -> do                        -- define "exit1"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            str <- callCC \$ \exit1 -> do                        -- define "exit1"
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                       -- define "exit2"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            n' <- callCC \$ \exit2 -> do                       -- define "exit2"
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) (exit2 n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            when ((length ns) < 5) (exit2 n)
-                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')  --escape 2 levels                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           exit1 (dropWhile (=='0') ns')  --escape 2 levels
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
+ return \$ "Answer: " ++ str - + - ----- + - + - + -
+ - + - + - + - + - + - + - + - + Part III - Introduction Part III - Introduction - - -
- - - - - - - Combining monads the hard way Combining monads the hard way - - -
Prev: [[introIII.html|Part III - Introduction]]TOC: [[index.html|Contents]]Next: [[transformers.html|Monad transformers]]
fun :: IO String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
-                                                                            fun = do n <- (readLn::IO Int)         -- this is an IO monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            fun :: IO String
+                                                                                                                            fun = do n <- (readLn::IO Int)         -- this is an IO monad block
return \$ (`runCont` id) \$ do  -- this is a Cont monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                return \$ (`runCont` id) \$ do  -- this is a Cont monad block
-                                                                            str <- callCC \$ \exit1 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            str <- callCC \$ \exit1 -> do
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n' <- callCC \$ \exit2 -> do
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) (exit2 n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            when ((length ns) < 5) (exit2 n)
-                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              exit1 (dropWhile (=='0') ns')
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
toIO :: a -> IO a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +
+                                                                                                                            toIO :: a -> IO a
toIO x = return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          toIO x = return x

fun :: IO String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           fun :: IO String
-                                                                            fun = do n <- (readLn::IO Int)         -- this is an IO monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            fun = do n <- (readLn::IO Int)         -- this is an IO monad block
convert n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  convert n

-                                                                            convert :: Int -> IO String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            convert :: Int -> IO String
convert n = (`runCont` id) \$ do        -- this is a Cont monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       convert n = (`runCont` id) \$ do        -- this is a Cont monad block
-                                                                            str <- callCC \$ \exit1 -> do    -- str has type IO String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            str <- callCC \$ \exit1 -> do    -- str has type IO String
-                                                                            when (n < 10) (exit1 \$ toIO (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            when (n < 10) (exit1 \$ toIO (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do   -- n' has type IO Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            n' <- callCC \$ \exit2 -> do   -- n' has type IO Int
-                                                                            when ((length ns) < 3) (exit2 (toIO (length ns)))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 3) (exit2 (toIO (length ns)))
-                                                                            when ((length ns) < 5) (exit2 \$ do putStrLn "Enter a number:"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            when ((length ns) < 5) (exit2 \$ do putStrLn "Enter a number:"
return x)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  return x)
-                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)
exit1 \$ toIO (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       exit1 \$ toIO (dropWhile (=='0') ns')
return (toIO (sum ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     return (toIO (sum ns))
-                                                                            return \$ do num <- n'  -- this is an IO monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            return \$ do num <- n'  -- this is an IO monad block
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show num)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show num)
-                                                                            return \$ do s <- str -- this is an IO monad block                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            return \$ do s <- str -- this is an IO monad block
-                                                                            return \$ "Answer: " ++ s
+ return \$ "Answer: " ++ s + Even this trivial example has gotten confusing and ugly when we tried to combine different monads in the same computation. It works, but it isn't pretty. Comparing the code side-by-side shows the degree to which the manual monad combination strategy pollutes the code. Even this trivial example has gotten confusing and ugly when we tried to combine different monads in the same computation. It works, but it isn't pretty. Comparing the code side-by-side shows the degree to which the manual monad combination strategy pollutes the code. Line 2,151: Line 1,791: Manually combined monads from example 20 Manually combined monads from example 20 -
fun = do n <- (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +
+                                                                                                                            fun = do n <- (readLn::IO Int)
return \$ (`runCont` id) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               return \$ (`runCont` id) \$ do
-                                                                            str <- callCC \$ \exit1 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            str <- callCC \$ \exit1 -> do
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n' <- callCC \$ \exit2 -> do
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) (exit2 n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            when ((length ns) < 5) (exit2 n)
-                                                                            when ((length ns) < 7) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            when ((length ns) < 7) \$ do
let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              exit1 (dropWhile (=='0') ns')
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
+ return \$ "Answer: " ++ str -
convert n = (`runCont` id) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +
-                                                                            str <- callCC \$ \exit1 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +
-                                                                            when (n < 10) (exit1 \$ toIO (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            convert n = (`runCont` id) \$ do
+                                                                                                                            str <- callCC \$ \exit1 -> do
+                                                                                                                            when (n < 10) (exit1 \$ toIO (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n' <- callCC \$ \exit2 -> do
-                                                                            when ((length ns) < 3) (exit2 (toIO (length ns)))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 3) (exit2 (toIO (length ns)))
-                                                                            when ((length ns) < 5) (exit2 \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            when ((length ns) < 5) (exit2 \$ do
-                                                                            putStrLn "Enter a number:"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            putStrLn "Enter a number:"
return x)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  return x)
-                                                                            when ((length ns) < 7) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            when ((length ns) < 7) \$ do
let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      let ns' = map intToDigit (reverse ns)
exit1 \$ toIO (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       exit1 \$ toIO (dropWhile (=='0') ns')
return (toIO (sum ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     return (toIO (sum ns))
-                                                                            return \$ do num <- n'                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            return \$ do num <- n'
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show num)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show num)
-                                                                            return \$ do s <- str                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ do s <- str
-                                                                            return \$ "Answer: " ++ s
+ return \$ "Answer: " ++ s - + - ----- + - + - + -
Prev: [[introIII.html|Part III - Introduction]]TOC: [[index.html|Contents]]Next: [[transformers.html|Monad transformers]]
+ - + - + - + - + - + - + - + - + Monad transformers Monad transformers - - -
fun :: IO String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            fun :: IO String
fun = (`runContT` return) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             fun = (`runContT` return) \$ do
-                                                                            n   <- liftIO (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n   <- liftIO (readLn::IO Int)
-                                                                            str <- callCC \$ \exit1 -> do     -- define "exit1"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            str <- callCC \$ \exit1 -> do     -- define "exit1"
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do    -- define "exit2"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            n' <- callCC \$ \exit2 -> do    -- define "exit2"
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) \$ do liftIO \$ putStrLn "Enter a number:"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            when ((length ns) < 5) \$ do liftIO \$ putStrLn "Enter a number:"
-                                                                            x <- liftIO (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            x <- liftIO (readLn::IO Int)
exit2 x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    exit2 x
-                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            when ((length ns) < 7) \$ do let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')  --escape 2 levels                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           exit1 (dropWhile (=='0') ns')  --escape 2 levels
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
+ return \$ "Answer: " ++ str - Compare this function using ContT, the transformer version of Cont, with the original version to see how unobtrusive the changes become when using the monad transformer. + + Compare this function using ContT, the transformer version of Cont, with the original version to see how unobtrusive the changes become when using the monad transformer. Nested monads from example 19 Nested monads from example 19 Line 2,258: Line 1,875: Monads combined with a transformer from example 21 Monads combined with a transformer from example 21 -
fun = do n <- (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +
+                                                                                                                            fun = do n <- (readLn::IO Int)
return \$ (`runCont` id) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               return \$ (`runCont` id) \$ do
-                                                                            str <- callCC \$ \exit1 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            str <- callCC \$ \exit1 -> do
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n' <- callCC \$ \exit2 -> do
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) (exit2 n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            when ((length ns) < 5) (exit2 n)
-                                                                            when ((length ns) < 7) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            when ((length ns) < 7) \$ do
let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              exit1 (dropWhile (=='0') ns')
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
+ return \$ "Answer: " ++ str -
fun = (`runContT` return) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
-                                                                            n   <- liftIO (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +
-                                                                            str <- callCC \$ \exit1 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            fun = (`runContT` return) \$ do
-                                                                            when (n < 10) (exit1 (show n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n   <- liftIO (readLn::IO Int)
+                                                                                                                            str <- callCC \$ \exit1 -> do
+                                                                                                                            when (n < 10) (exit1 (show n))
let ns = map digitToInt (show (n `div` 2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 let ns = map digitToInt (show (n `div` 2))
-                                                                            n' <- callCC \$ \exit2 -> do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            n' <- callCC \$ \exit2 -> do
-                                                                            when ((length ns) < 3) (exit2 (length ns))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            when ((length ns) < 3) (exit2 (length ns))
-                                                                            when ((length ns) < 5) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            when ((length ns) < 5) \$ do
-                                                                            liftIO \$ putStrLn "Enter a number:"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            liftIO \$ putStrLn "Enter a number:"
-                                                                            x <- liftIO (readLn::IO Int)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            x <- liftIO (readLn::IO Int)
exit2 x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    exit2 x
-                                                                            when ((length ns) < 7) \$ do                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            when ((length ns) < 7) \$ do
let ns' = map intToDigit (reverse ns)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      let ns' = map intToDigit (reverse ns)
exit1 (dropWhile (=='0') ns')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              exit1 (dropWhile (=='0') ns')
return \$ sum ns                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            return \$ sum ns
-                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            return \$ "(ns = " ++ (show ns) ++ ") " ++ (show n')
-                                                                            return \$ "Answer: " ++ str
+ return \$ "Answer: " ++ str + The impact of adding the I/O in the middle of the computation is narrowly confined when using the monad transformer. Contrast this with the [[hardway.html#comparison|changes]] required to achieve the same result using a manually combined monad. The impact of adding the I/O in the middle of the computation is narrowly confined when using the monad transformer. Contrast this with the [[hardway.html#comparison|changes]] required to achieve the same result using a manually combined monad. - - - ----- - - -
- - - - - - - Standard monad transformers Standard monad transformers - - -
-                                                                            lift :: (Monad m) => m a -> t m a
+ class MonadTrans t where - Monads which provide optimized support for lifting IO operations are defined as members of the MonadIO class, which defines the liftIO function. + lift :: (Monad m) => m a -> t m a + + Monads which provide optimized support for lifting IO operations are defined as members of the MonadIO class, which defines the liftIO function. -
-                                                                            liftIO :: IO a -> m a
Line 2,348: Line 1,943: - -
- + - + - + - + - + - + - + - + - + - + - - [[Image:info.png]] Order is important when combining monads. StateT s (Error e) is different than ErrorT e (State s). The first produces a combined type of s -> Error e (a,s), in which the computation can either return a new state or generate an error. The second combination produces a combined type of s -> (Error e a,s), in which the computation always returns a new state, and the value can be an error or a normal value.
+ [[Image:info.png]] Order is important when combining monads. StateT s (Error e) is different than ErrorT e (State s). The first produces a combined type of s -> Error e (a,s), in which the computation can either return a new state or generate an error. The second combination produces a combined type of s -> (Error e a,s), in which the computation always returns a new state, and the value can be an error or a normal value.
- - - ----- - - -
- - - - - - - Anatomy of a monad transformer Anatomy of a monad transformer - - -
newtype State s a = State { runState :: (s -> (a,s)) }
+ + newtype State s a = State { runState :: (s -> (a,s)) } + the StateT transformer is built upon the definition the StateT transformer is built upon the definition -
newtype StateT s m a = StateT { runStateT :: (s -> m (a,s)) }
newtype StateT s m a = StateT { runStateT :: (s -> m (a,s)) }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            newtype StateT s m a = StateT { runStateT :: (s -> m (a,s)) }

-                                                                            return a          = StateT \$ \s -> return (a,s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            return a          = StateT \$ \s -> return (a,s)
-                                                                            (StateT x) >>= f  = StateT \$ \s -> do (v,s')      <- x s            -- get new value, state                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            (StateT x) >>= f  = StateT \$ \s -> do (v,s')      <- x s            -- get new value, state
-                                                                            (StateT x') <- return \$ f v   -- apply bound function to get new state transformation fn                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            (StateT x') <- return \$ f v   -- apply bound function to get new state transformation fn
-                                                                            x' s'                         -- apply the state transformation fn to the new state
+ x' s' -- apply the state transformation fn to the new state - Compare this to the definition for [[statemonad.html#definition|State s]]. Our definition of return makes use of the return function of the inner monad, and the binding operator uses a do-block to perform a computation in the inner monad. + + Compare this to the definition for [[statemonad.html#definition|State s]]. Our definition of return makes use of the return function of the inner monad, and the binding operator uses a do-block to perform a computation in the inner monad. - We also want to declare all combined monads that use the StateT transformer to be instaces of the MonadState class, so we will have to give definitions for get and put: + We also want to declare all combined monads that use the StateT transformer to be instaces of the MonadState class, so we will have to give definitions for get and put: -
-                                                                            get   = StateT \$ \s -> return (s,s)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            instance (Monad m) => MonadState s (StateT s m) where
-                                                                            put s = StateT \$ \_ -> return ((),s)
+ get = StateT \$ \s -> return (s,s) - Finally, we want to declare all combined monads in which StateT is used with an instance of MonadPlus to be instances of MonadPlus: + put s = StateT \$ \_ -> return ((),s) + + Finally, we want to declare all combined monads in which StateT is used with an instance of MonadPlus to be instances of MonadPlus: -
-                                                                            mzero = StateT \$ \s -> mzero                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            instance (MonadPlus m) => MonadPlus (StateT s m) where
-                                                                            (StateT x1) `mplus` (StateT x2) = StateT \$ \s -> (x1 s) `mplus` (x2 s)
+ mzero = StateT \$ \s -> mzero + (StateT x1) `mplus` (StateT x2) = StateT \$ \s -> (x1 s) `mplus` (x2 s) + == Defining the lifting function == == Defining the lifting function == - The final step to make our monad transformer fully integrated with Haskell's monad classes is to make StateT s an instance of the MonadTrans class by providing a lift function: + The final step to make our monad transformer fully integrated with Haskell's monad classes is to make StateT s an instance of the MonadTrans class by providing a lift function: -
instance MonadTrans (StateT s) where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +
-                                                                            lift c = StateT \$ \s -> c >>= (\x -> return (x,s))
+ - + - + - + - + - + - + - + More examples with monad transformers More examples with monad transformers - - -
Prev: [[xformeranatomy.html|Anatomy of a monad transformer]]TOC: [[index.html|Contents]]Next: [[stacking.html|Managing the transformer stack]]
-- this is the format of our log entries                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
+                                                                                                                            -- this is the format of our log entries
data Entry = Log {timestamp::ClockTime, msg::String} deriving Eq                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           data Entry = Log {timestamp::ClockTime, msg::String} deriving Eq

instance Show Entry where                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  instance Show Entry where
-                                                                            show (Log t s) = (show t) ++ " | " ++ s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            show (Log t s) = (show t) ++ " | " ++ s

-- this is the combined monad type                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -- this is the combined monad type
Line 2,519:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,064:

-- add a message to the log                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -- add a message to the log
-                                                                            logMsg :: String -> LogWriter ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            logMsg :: String -> LogWriter ()
-                                                                            logMsg s = do t <- liftIO getClockTime                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            logMsg s = do t <- liftIO getClockTime
tell [Log t s]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             tell [Log t s]

-- this handles one packet                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- this handles one packet
-                                                                            filterOne :: [Rule] -> Packet -> LogWriter (Maybe Packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            filterOne :: [Rule] -> Packet -> LogWriter (Maybe Packet)
-                                                                            filterOne rules packet = do rule <- return (match rules packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            filterOne rules packet = do rule <- return (match rules packet)
case rule of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               case rule of
-                                                                            Nothing  -> do logMsg ("DROPPING UNMATCHED PACKET: " ++ (show packet))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            Nothing  -> do logMsg ("DROPPING UNMATCHED PACKET: " ++ (show packet))
return Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             return Nothing
-                                                                            (Just r) -> do when (logIt r) (logMsg ("MATCH: " ++ (show r) ++ " <=> " ++ (show packet)))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +                                                                                                                            (Just r) -> do when (logIt r) (logMsg ("MATCH: " ++ (show r) ++ " <=> " ++ (show packet)))
case r of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  case r of
-                                                                            (Rule Accept _ _) -> return (Just packet)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            (Rule Accept _ _) -> return (Just packet)
-                                                                            (Rule Reject _ _) -> return Nothing                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            (Rule Reject _ _) -> return Nothing

-- this filters a list of packets, producing a filtered packet list                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        -- this filters a list of packets, producing a filtered packet list
-- and a log of the activity                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- and a log of the activity
-                                                                            filterAll :: [Rule] -> [Packet] -> LogWriter [Packet]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            filterAll :: [Rule] -> [Packet] -> LogWriter [Packet]
-                                                                            filterAll rules packets = do logMsg "STARTING PACKET FILTER"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            filterAll rules packets = do logMsg "STARTING PACKET FILTER"
-                                                                            out <- mapM (filterOne rules) packets                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            out <- mapM (filterOne rules) packets
-                                                                            logMsg "STOPPING PACKET FILTER"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            logMsg "STOPPING PACKET FILTER"
return (catMaybes out)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     return (catMaybes out)

Line 2,546:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,091:
-- a log generated during the computation.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- a log generated during the computation.
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do args       <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            main = do args       <- getArgs
-                                                                            (out,log) <- runWriterT (filterAll rules packets)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            (out,log) <- runWriterT (filterAll rules packets)
-                                                                            putStrLn "ACCEPTED PACKETS"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            putStrLn "ACCEPTED PACKETS"
putStr (unlines (map show out))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            putStr (unlines (map show out))
-                                                                            putStrLn "\n\nFIREWALL LOG"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            putStrLn "\n\nFIREWALL LOG"
-                                                                            putStr (unlines (map show log))
-- First, we develop a language to express logic problems                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +
+                                                                                                                            -- First, we develop a language to express logic problems
type Var   = String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        type Var   = String
type Value = String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        type Value = String
Line 2,583:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,130:

-- test for a variable NOT equaling a value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -- test for a variable NOT equaling a value
-                                                                            isNot :: Var -> Value -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            isNot :: Var -> Value -> Predicate
isNot var value = Not (Is var value)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       isNot var value = Not (Is var value)

-- if a is true, then b must also be true                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- if a is true, then b must also be true
-                                                                            implies :: Predicate -> Predicate -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            implies :: Predicate -> Predicate -> Predicate
implies a b = Not (a `And` (Not b))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        implies a b = Not (a `And` (Not b))

-- exclusive or                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- exclusive or
-                                                                            orElse :: Predicate -> Predicate -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            orElse :: Predicate -> Predicate -> Predicate
orElse a b = (a `And` (Not b)) `Or` ((Not a) `And` b)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      orElse a b = (a `And` (Not b)) `Or` ((Not a) `And` b)

-- Check a predicate with the given variable bindings.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     -- Check a predicate with the given variable bindings.
-- An unbound variable causes a Nothing return value.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- An unbound variable causes a Nothing return value.
-                                                                            check :: Predicate -> Variables -> Maybe Bool                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            check :: Predicate -> Variables -> Maybe Bool
-                                                                            check (Is var value) vars = do val <- lookup var vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            check (Is var value) vars = do val <- lookup var vars
return (val == value)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      return (val == value)
-                                                                            check (Equal v1 v2)  vars = do val1 <- lookup v1 vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            check (Equal v1 v2)  vars = do val1 <- lookup v1 vars
-                                                                            val2 <- lookup v2 vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            val2 <- lookup v2 vars
return (val1 == val2)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      return (val1 == val2)
-                                                                            check (And p1 p2)    vars = liftM2 (&&) (check p1 vars) (check p2 vars)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            check (And p1 p2)    vars = liftM2 (&&) (check p1 vars) (check p2 vars)
check (Or  p1 p2)    vars = liftM2 (||) (check p1 vars) (check p2 vars)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    check (Or  p1 p2)    vars = liftM2 (||) (check p1 vars) (check p2 vars)
-                                                                            check (Not p)        vars = liftM (not) (check p vars)
+ check (Not p) vars = liftM (not) (check p vars) + The next thing we will need is some code for representing and solving constraint satisfaction problems. This is where we will define our combined monad. The next thing we will need is some code for representing and solving constraint satisfaction problems. This is where we will define our combined monad. Code available in [[../examples/example24.hs|example24.hs]] Code available in [[../examples/example24.hs|example24.hs]] -
-- this is the type of our logic problem                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +
+                                                                                                                            -- this is the type of our logic problem
data ProblemState = PS {vars::Variables, constraints::[Predicate]}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         data ProblemState = PS {vars::Variables, constraints::[Predicate]}

Line 2,616:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,165:

-- lookup a variable                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- lookup a variable
-                                                                            getVar :: Var -> NDS (Maybe Value)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            getVar :: Var -> NDS (Maybe Value)
-                                                                            getVar v = do vs <- gets vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            getVar v = do vs <- gets vars
return \$ lookup v vs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       return \$ lookup v vs

-- set a variable                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          -- set a variable
-                                                                            setVar :: Var -> Value -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            setVar :: Var -> Value -> NDS ()
-                                                                            setVar v x = do st <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            setVar v x = do st <- get
-                                                                            vs' <- return \$ filter ((v/=).fst) (vars st)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            vs' <- return \$ filter ((v/=).fst) (vars st)
put \$ st {vars=(v,x):vs'}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  put \$ st {vars=(v,x):vs'}

Line 2,631:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,180:
-- allows us to accept partial solutions, then we can use a value of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- allows us to accept partial solutions, then we can use a value of
-- False at the end to signify that all solutions should be complete.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- False at the end to signify that all solutions should be complete.
-                                                                            isConsistent :: Bool -> NDS Bool                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            isConsistent :: Bool -> NDS Bool
-                                                                            isConsistent partial = do cs <- gets constraints                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            isConsistent partial = do cs <- gets constraints
-                                                                            vs <- gets vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            vs <- gets vars
-                                                                            let results = map (\p->check p vs) cs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            let results = map (\p->check p vs) cs
return \$ and (map (maybe partial id) results)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              return \$ and (map (maybe partial id) results)

-- Return only the variable bindings that are complete consistent solutions.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- Return only the variable bindings that are complete consistent solutions.
getFinalVars :: NDS Variables                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              getFinalVars :: NDS Variables
-                                                                            getFinalVars = do c <- isConsistent False                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            getFinalVars = do c <- isConsistent False
guard c                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    guard c
gets vars                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  gets vars
Line 2,646:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,195:
-- an initial problem state and then returning the first solution in the result list,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- an initial problem state and then returning the first solution in the result list,
-- or Nothing if there was no solution.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- or Nothing if there was no solution.
-                                                                            getSolution :: NDS a -> ProblemState -> Maybe a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            getSolution :: NDS a -> ProblemState -> Maybe a
getSolution c i = listToMaybe (evalStateT c i)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             getSolution c i = listToMaybe (evalStateT c i)

-- Get a list of all possible solutions to the problem by evaluating the solver                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- Get a list of all possible solutions to the problem by evaluating the solver
-- computation with an initial problem state.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- computation with an initial problem state.
-                                                                            getAllSolutions :: NDS a -> ProblemState -> [a]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            getAllSolutions :: NDS a -> ProblemState -> [a]
-                                                                            getAllSolutions c i = evalStateT c i
+ getAllSolutions c i = evalStateT c i + We are ready to apply the predicate language and stateful nondeterministic monad to solving a logic problem. For this example, we will use the well-known Kalotan puzzle which appeared in ''Mathematical Brain-Teasers'', Dover Publications (1976), by J. A. H. Hunter. We are ready to apply the predicate language and stateful nondeterministic monad to solving a logic problem. For this example, we will use the well-known Kalotan puzzle which appeared in ''Mathematical Brain-Teasers'', Dover Publications (1976), by J. A. H. Hunter. Line 2,660: Line 2,210: Code available in [[../examples/example24.hs|example24.hs]] Code available in [[../examples/example24.hs|example24.hs]] -
-- if a male says something, it must be true                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +
-                                                                            said :: Var -> Predicate -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            -- if a male says something, it must be true
-                                                                            said v p = (v `Is` "male") `implies` p                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            said :: Var -> Predicate -> Predicate
+                                                                                                                            said v p = (v `Is` "male") `implies` p

-- if a male says two things, they must be true                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- if a male says two things, they must be true
-- if a female says two things, one must be true and one must be false                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     -- if a female says two things, one must be true and one must be false
-                                                                            saidBoth :: Var -> Predicate -> Predicate -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            saidBoth :: Var -> Predicate -> Predicate -> Predicate
-                                                                            saidBoth v p1 p2 = And ((v `Is` "male") `implies` (p1 `And` p2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            saidBoth v p1 p2 = And ((v `Is` "male") `implies` (p1 `And` p2))
-                                                                            ((v `Is` "female") `implies` (p1 `orElse` p2))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            ((v `Is` "female") `implies` (p1 `orElse` p2))

-- lying is saying something is true when it isn't or saying something isn't true when it is                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               -- lying is saying something is true when it isn't or saying something isn't true when it is
-                                                                            lied :: Var -> Predicate -> Predicate                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            lied :: Var -> Predicate -> Predicate
lied v p = ((v `said` p) `And` (Not p)) `orElse` ((v `said` (Not p)) `And` p)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              lied v p = ((v `said` p) `And` (Not p)) `orElse` ((v `said` (Not p)) `And` p)

-- Test consistency over all allowed settings of the variable.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             -- Test consistency over all allowed settings of the variable.
-                                                                            tryAllValues :: Var -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            tryAllValues :: Var -> NDS ()
-                                                                            tryAllValues var = do (setVar var "male") `mplus` (setVar var "female")                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            tryAllValues var = do (setVar var "male") `mplus` (setVar var "female")
-                                                                            c <- isConsistent True                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            c <- isConsistent True
-                                                                            guard c
+ guard c + All that remains to be done is to define the puzzle in the predicate language and get a solution that satisfies all of the predicates: All that remains to be done is to define the puzzle in the predicate language and get a solution that satisfies all of the predicates: Code available in [[../examples/example24.hs|example24.hs]] Code available in [[../examples/example24.hs|example24.hs]] -
-- Define the problem, try all of the variable assignments and print a solution.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +
+                                                                                                                            -- Define the problem, try all of the variable assignments and print a solution.
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
main = do let variables   = []                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             main = do let variables   = []
-                                                                            constraints = [ Not (Equal "parent1" "parent2"),                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            constraints = [ Not (Equal "parent1" "parent2"),
-                                                                            "parent1" `said` ("child" `said` ("child" `Is` "male")),                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            "parent1" `said` ("child" `said` ("child" `Is` "male")),
-                                                                            saidBoth "parent2" ("child" `Is` "female")                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            saidBoth "parent2" ("child" `Is` "female")
-                                                                            ("child" `lied` ("child" `Is` "male")) ]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            ("child" `lied` ("child" `Is` "male")) ]
problem     = PS variables constraints                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     problem     = PS variables constraints
-                                                                            print \$ (`getSolution` problem) \$ do tryAllValues "parent1"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            print \$ (`getSolution` problem) \$ do tryAllValues "parent1"
-                                                                            tryAllValues "parent2"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            tryAllValues "parent2"
-                                                                            tryAllValues "child"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            tryAllValues "child"
-                                                                            getFinalVars
+ getFinalVars - Each call to tryAllValues will fork the solution space, assigning the named variable to be "male" in one fork and "female" in the other. The forks which produce inconsistent variable assignments are eliminated (using the guard function). The call to getFinalVars applies guard again to eliminate inconsistent variable assignments and returns the remaining assignments as the value of the computation. + - + Each call to tryAllValues will fork the solution space, assigning the named variable to be "male" in one fork and "female" in the other. The forks which produce inconsistent variable assignments are eliminated (using the guard function). The call to getFinalVars applies guard again to eliminate inconsistent variable assignments and returns the remaining assignments as the value of the computation. - + - ----- + - + - + -
Prev: [[xformeranatomy.html|Anatomy of a monad transformer]]TOC: [[index.html|Contents]]Next: [[stacking.html|Managing the transformer stack]]
+ - + - + - + - + - + - + - + Managing the transformer stack Managing the transformer stack - - -
Prev: [[xformerexamples.html|More examples with monad transformers]]TOC: [[index.html|Contents]]Next: [[beyond.html|Continuing Exploration]]
-- this is the type of our problem description                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
+                                                                                                                            -- this is the type of our problem description
data NQueensProblem = NQP {board::Board,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   data NQueensProblem = NQP {board::Board,
ranks::[Rank],   files::[File],                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ranks::[Rank],   files::[File],
Line 2,757:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,282:

-- initial state = empty board, all ranks, files, and diagonals free                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- initial state = empty board, all ranks, files, and diagonals free
-                                                                            initialState = let fileA = map (\r->Pos A r) [1..8]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        +                                                                                                                            initialState = let fileA = map (\r->Pos A r) [1..8]
-                                                                            rank8 = map (\f->Pos f 8) [A .. H]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            rank8 = map (\f->Pos f 8) [A .. H]
-                                                                            rank1 = map (\f->Pos f 1) [A .. H]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            rank1 = map (\f->Pos f 1) [A .. H]
asc   = map Ascending (nub (fileA ++ rank1))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               asc   = map Ascending (nub (fileA ++ rank1))
desc  = map Descending (nub (fileA ++ rank8))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              desc  = map Descending (nub (fileA ++ rank8))
Line 2,770:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,295:
-- an initial problem state and then returning the first solution in the result list,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- an initial problem state and then returning the first solution in the result list,
-- or Nothing if there was no solution.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    -- or Nothing if there was no solution.
-                                                                            getSolution :: NDS a -> NQueensProblem -> Maybe (a,[String])                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            getSolution :: NDS a -> NQueensProblem -> Maybe (a,[String])
getSolution c i = listToMaybe (evalStateT (runWriterT c) i)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                getSolution c i = listToMaybe (evalStateT (runWriterT c) i)

-- add a Queen to the board in a specific position                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -- add a Queen to the board in a specific position
-                                                                            addQueen :: Position -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            addQueen :: Position -> NDS ()
-                                                                            addQueen p = do (Board b) <- gets board                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            addQueen p = do (Board b) <- gets board
-                                                                            rs <- gets ranks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            rs <- gets ranks
-                                                                            fs <- gets files                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            fs <- gets files
-                                                                            as <- gets asc                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            as <- gets asc
-                                                                            ds <- gets desc                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            ds <- gets desc
let b'  = (Piece Black Queen, p):b                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         let b'  = (Piece Black Queen, p):b
rs' = delete (rank p) rs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   rs' = delete (rank p) rs
Line 2,786:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,311:
as' = delete a as                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          as' = delete a as
ds' = delete d ds                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ds' = delete d ds
-                                                                            tell ["Added Queen at " ++ (show p)]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            tell ["Added Queen at " ++ (show p)]
put (NQP (Board b') rs' fs' as' ds')                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       put (NQP (Board b') rs' fs' as' ds')

-- test if a position is in the set of allowed diagonals                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   -- test if a position is in the set of allowed diagonals
-                                                                            inDiags :: Position -> NDS Bool                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            inDiags :: Position -> NDS Bool
inDiags p = do let (a,d) = getDiags p                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      inDiags p = do let (a,d) = getDiags p
-                                                                            as <- gets asc                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            as <- gets asc
-                                                                            ds <- gets desc                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            ds <- gets desc
-                                                                            return \$ (elem a as) && (elem d ds)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            return \$ (elem a as) && (elem d ds)

-- add a Queen to the board in all allowed positions                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       -- add a Queen to the board in all allowed positions
-                                                                            addQueens = do rs <- gets ranks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            +                                                                                                                            addQueens = do rs <- gets ranks
-                                                                            fs <- gets files                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +                                                                                                                            fs <- gets files
-                                                                            allowed <- filterM inDiags [Pos f r | f <- fs, r <- rs]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            allowed <- filterM inDiags [Pos f r | f <- fs, r <- rs]
-                                                                            tell [show (length allowed) ++ " possible choices"]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            tell [show (length allowed) ++ " possible choices"]

Line 2,807:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,332:
-- then get the board and print the solution along with the log                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- then get the board and print the solution along with the log
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do args <- getArgs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            main = do args <- getArgs
Line 2,813:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,338:
gets board                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 gets board
case sol of                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                case sol of
-                                                                            Just (b,l) -> do putStr \$ show b    -- show the solution                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            Just (b,l) -> do putStr \$ show b    -- show the solution
putStr \$ unlines l -- show the log                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         putStr \$ unlines l -- show the log
-                                                                            Nothing    -> putStrLn "No solution"
logString :: String -> StateT MyState (WriterT [String] []) Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
-                                                                            logString s = ...
+ logString :: String -> StateT MyState (WriterT [String] []) Int + logString s = ... + we can write clearer, more flexible code like: we can write clearer, more flexible code like: -
logString :: (MonadWriter [String] m) => String -> m Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           +
-                                                                            logString s = ...
+ logString :: (MonadWriter [String] m) => String -> m Int - and then lift the logString computation into the combined monad when we use it. + logString s = ... + + and then lift the logString computation into the combined monad when we use it. - [[Image:info.png]] You may need to use the compiler flags -fglasgow-exts with GHC or the equivalent flags with your Haskell compiler to use this technique. The issue is that m in the constraint above is a type constructor, not a type, and this is not supported in standard Haskell 98.
+ [[Image:info.png]] You may need to use the compiler flags -fglasgow-exts with GHC or the equivalent flags with your Haskell compiler to use this technique. The issue is that m in the constraint above is a type constructor, not a type, and this is not supported in standard Haskell 98.
- When using lifting with complex transformer stacks, you may find yourself composing multiple lifts, like lift . lift . lift \$ f x. This can become hard to follow, and if the transformer stack changes (perhaps you add ErrorT into the mix) the lifting may need to be changed all over the code. A good practice to prevent this is to declare helper functions with informative names to do the lifting: + When using lifting with complex transformer stacks, you may find yourself composing multiple lifts, like lift . lift . lift \$ f x. This can become hard to follow, and if the transformer stack changes (perhaps you add ErrorT into the mix) the lifting may need to be changed all over the code. A good practice to prevent this is to declare helper functions with informative names to do the lifting: -
liftListToState = lift . lift . lift
+ + liftListToState = lift . lift . lift + Then, the code is more informative and if the transformer stack changes, the impact on the lifting code is confined to a small number of these helper functions. Then, the code is more informative and if the transformer stack changes, the impact on the lifting code is confined to a small number of these helper functions. Line 2,846: Line 2,378: Code available in [[../examples/example26.hs|example26.hs]] Code available in [[../examples/example26.hs|example26.hs]] -
-- this is our combined monad type for this problem                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +
+                                                                                                                            -- this is our combined monad type for this problem
type NDS a = StateT Int (WriterT [String] []) a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            type NDS a = StateT Int (WriterT [String] []) a

Line 2,852:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,385:

-- return the digits of a number as a list                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 -- return the digits of a number as a list
-                                                                            getDigits :: Int -> [Int]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            getDigits :: Int -> [Int]
getDigits n = let s = (show n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             getDigits n = let s = (show n)
in map digitToInt s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        in map digitToInt s
Line 2,859:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,392:

-- write a value to a log and return that value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            -- write a value to a log and return that value
-                                                                            logVal :: (MonadWriter [String] m) => Int -> m Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            logVal :: (MonadWriter [String] m) => Int -> m Int
-                                                                            logVal n = do tell ["logVal: " ++ (show n)]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            logVal n = do tell ["logVal: " ++ (show n)]
return n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return n

-- do a logging computation and return the length of the log it wrote                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- do a logging computation and return the length of the log it wrote
-                                                                            getLogLength :: (MonadWriter [[a]] m) => m b -> m Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            getLogLength :: (MonadWriter [[a]] m) => m b -> m Int
-                                                                            getLogLength c = do (_,l) <- listen \$ c                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            getLogLength c = do (_,l) <- listen \$ c
return (length (concat l))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 return (length (concat l))

-- log a string value and return 0                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -- log a string value and return 0
-                                                                            logString :: (MonadWriter [String] m) => String -> m Int                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            logString :: (MonadWriter [String] m) => String -> m Int
-                                                                            logString s = do tell ["logString: " ++ s]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            logString s = do tell ["logString: " ++ s]
return 0                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return 0

{- Here is a computation that requires a WriterT [String] [] -}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            {- Here is a computation that requires a WriterT [String] [] -}

-                                                                            -- "Fork" the computation and log each list item in a different branch.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            -- "Fork" the computation and log each list item in a different branch.
-                                                                            logEach :: (Show a) => [a] -> WriterT [String] [] a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            logEach :: (Show a) => [a] -> WriterT [String] [] a
-                                                                            logEach xs = do x <- lift xs                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               +                                                                                                                            logEach xs = do x <- lift xs
-                                                                            tell ["logEach: " ++ (show x)]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            tell ["logEach: " ++ (show x)]
return x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   return x

Line 2,884:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,417:

-- increment the state by a specified value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                -- increment the state by a specified value
-                                                                            addVal n = do x <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     +                                                                                                                            addVal n = do x <- get
put (x+n)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  put (x+n)

Line 2,891:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,424:

-- set the state to a given value, and log that value                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- set the state to a given value, and log that value
-                                                                            setVal :: Int -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            setVal :: Int -> NDS ()
-                                                                            setVal n = do x <- lift \$ logVal n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            setVal n = do x <- lift \$ logVal n
put x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      put x

-                                                                            -- "Fork" the computation, adding a different digit to the state in each branch.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            -- "Fork" the computation, adding a different digit to the state in each branch.
-- Because setVal is used, the new values are logged as well.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -- Because setVal is used, the new values are logged as well.
-                                                                            addDigits :: Int -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            addDigits :: Int -> NDS ()
-                                                                            addDigits n = do x  <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            addDigits n = do x  <- get
-                                                                            y <- lift . lift \$ getDigits n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             +                                                                                                                            y <- lift . lift \$ getDigits n
setVal (x+y)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               setVal (x+y)

{- an equivalent construction is:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          {- an equivalent construction is:
-                                                                            addDigits :: Int -> NDS ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 +                                                                                                                            addDigits :: Int -> NDS ()
-                                                                            addDigits n = do x <- get                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            addDigits n = do x <- get
-                                                                            msum (map (\i->setVal (x+i)) (getDigits n))                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            msum (map (\i->setVal (x+i)) (getDigits n))
-}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -}

Line 2,913:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,446:
lifting logic are confined to a small number of functions.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 lifting logic are confined to a small number of functions.
-}                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         -}
-                                                                            liftListToNDS :: [a] -> NDS a                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            liftListToNDS :: [a] -> NDS a
liftListToNDS = lift . lift                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                liftListToNDS = lift . lift

Line 2,919:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,452:
main :: IO ()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              main :: IO ()
-                                                                            main = do mapM_ print \$ runWriterT \$ (`evalStateT` 0) \$ do x <- lift \$ getLogLength \$ logString "hello"                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            main = do mapM_ print \$ runWriterT \$ (`evalStateT` 0) \$ do x <- lift \$ getLogLength \$ logString "hello"
-                                                                            x <- lift \$ logEach [1,3,5]                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            x <- lift \$ logEach [1,3,5]
lift \$ logVal x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            lift \$ logVal x
liftListToNDS \$ getDigits 287                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              liftListToNDS \$ getDigits 287
-
+ + Once you fully understand how the various lifts in the example work and how lifting promotes code reuse, you are ready for real-world monadic programming. All that is left to do is to hone your skills writing real software. Happy hacking! Once you fully understand how the various lifts in the example work and how lifting promotes code reuse, you are ready for real-world monadic programming. All that is left to do is to hone your skills writing real software. Happy hacking! - - - ----- - - -
Prev: [[xformerexamples.html|More examples with monad transformers]]TOC: [[index.html|Contents]]Next: [[beyond.html|Continuing Exploration]]
- - - - - - - Continuing Exploration Continuing Exploration - - -
Prev: [[stacking.html|Managing the transformer stack]]TOC: [[index.html|Contents]]Next: [[analogy.html|Appendix I - A physical analogy for monads]]
Prev: [[stacking.html|Managing the transformer stack]]TOC: [[index.html|Contents]]Next: [[analogy.html|Appendix I - A physical analogy for monads]]
- - - - - - - A physical analogy for monads A physical analogy for monads - - -
- - - - - - - = A physical analogy for monads = = A physical analogy for monads = Line 3,019: Line 2,504: Lets take the example of an assembly line to make chopsticks, and see how it is handled in our physical analogy and how me might represent it as a program in Haskell. We will have three worker machines. The first takes small pieces of wood as input and outputs a tray containing a pair of roughly shaped chopsticks. The second takes a pair of roughly shaped chopsticks and outputs a tray containing a pair of smooth, polished chopsticks with the name of the restaurant printed on them. The third takes a pair of polished chopsticks and outputs a tray containing a finished pair of chopsticks in a printed paper wrapper. We could represent this in Haskell as: Lets take the example of an assembly line to make chopsticks, and see how it is handled in our physical analogy and how me might represent it as a program in Haskell. We will have three worker machines. The first takes small pieces of wood as input and outputs a tray containing a pair of roughly shaped chopsticks. The second takes a pair of roughly shaped chopsticks and outputs a tray containing a pair of smooth, polished chopsticks with the name of the restaurant printed on them. The third takes a pair of polished chopsticks and outputs a tray containing a finished pair of chopsticks in a printed paper wrapper. We could represent this in Haskell as: -
-- the basic types we are dealing with                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +
+                                                                                                                            -- the basic types we are dealing with
type Wood = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            type Wood = ...
type Chopsticks = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      type Chopsticks = ...
Line 3,027:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                Line 2,513:

-- worker function 1: makes roughly shaped chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      -- worker function 1: makes roughly shaped chopsticks
-                                                                            makeChopsticks :: Wood -> Tray Chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            makeChopsticks :: Wood -> Tray Chopsticks
makeChopsticks w = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     makeChopsticks w = ...

-- worker function 2: polishes chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  -- worker function 2: polishes chopsticks
-                                                                            polishChopsticks :: Chopsticks -> Tray Chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          +                                                                                                                            polishChopsticks :: Chopsticks -> Tray Chopsticks
polishChopsticks c = ...                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   polishChopsticks c = ...

-- worker function 3: wraps chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     -- worker function 3: wraps chopsticks
-                                                                            wrapChopsticks :: Chopsticks -> Tray Wrapper Chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    +                                                                                                                            wrapChopsticks :: Chopsticks -> Tray Wrapper Chopsticks
-                                                                            wrapChopsticks c = ...
+ wrapChopsticks c = ... - It is clear that the worker machines contain all of the functionality needed to produce chopsticks. What is missing is the specification of the trays, loader, and combiner machines that collectively make up the Tray monad. Our trays should either be empty or contain a single item. Our loader machine would simply take an item and place it in a tray on the conveyor belt. The combiner machine would take each input tray and pass along empty trays while feeding the contents of non-empty trays to its worker machine. In Haskell, we would define the Tray monad as: + + It is clear that the worker machines contain all of the functionality needed to produce chopsticks. What is missing is the specification of the trays, loader, and combiner machines that collectively make up the Tray monad. Our trays should either be empty or contain a single item. Our loader machine would simply take an item and place it in a tray on the conveyor belt. The combiner machine would take each input tray and pass along empty trays while feeding the contents of non-empty trays to its worker machine. In Haskell, we would define the Tray monad as: -
-- trays are either empty or contain a single item                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
+                                                                                                                            -- trays are either empty or contain a single item
data Tray x = Empty | Contains x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           data Tray x = Empty | Contains x

-                                                                            Empty        >>= _      = Empty                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         +                                                                                                                            Empty        >>= _      = Empty
-                                                                            (Contains x) >>= worker = worker x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      +                                                                                                                            (Contains x) >>= worker = worker x
return                  = Contains                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         return                  = Contains
-                                                                            fail _                  = Empty
+ fail _ = Empty - [[Image:info.png]] You may recognize the Tray monad as a disguised version of the Maybe monad that is a standard part of Haskell 98 library.
+ + [[Image:info.png]] You may recognize the Tray monad as a disguised version of the Maybe monad that is a standard part of Haskell 98 library.
Line 3,066: Line 2,555: In Haskell, the sequencing can be done using the standard monadic functions: In Haskell, the sequencing can be done using the standard monadic functions: -
assemblyLine :: Wood -> Tray Wrapped Chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
-                                                                            assemblyLine w = (return w) >>= makeChopsticks >>= polishChopsticks >>= wrapChopsticks
+ assemblyLine :: Wood -> Tray Wrapped Chopsticks + assemblyLine w = (return w) >>= makeChopsticks >>= polishChopsticks >>= wrapChopsticks + or using the built in Haskell "do" notation for monads: or using the built in Haskell "do" notation for monads: -
assemblyLine :: Wood -> Tray Wrapped Chopsticks                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
-                                                                            assemblyLine w = do c   <- makeChopsticks w                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                +                                                                                                                            assemblyLine :: Wood -> Tray Wrapped Chopsticks
-                                                                            c'  <- polishChopsticks c                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  +                                                                                                                            assemblyLine w = do c   <- makeChopsticks w
-                                                                            c'' <- wrapChopsticks c'                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            c'  <- polishChopsticks c
-                                                                            return c''
-- tray2s either contain a single item or contain a failure report                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       +
+                                                                                                                            -- tray2s either contain a single item or contain a failure report
data Tray2 x = Contains x | Failed String                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  data Tray2 x = Contains x | Failed String

-                                                                            (Failed reason) >>= _      = Failed reason                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              +                                                                                                                            (Failed reason) >>= _      = Failed reason
-                                                                            (Contains x)    >>= worker = worker x                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   +                                                                                                                            (Contains x)    >>= worker = worker x
return                     = Contains                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      return                     = Contains
-                                                                            fail reason                = Failed reason
+ fail reason = Failed reason - [[Image:info.png]] You may recognize the Tray2 monad as a disguised version of the Error monad that is a standard part of the Haskell 98 libraries.
+ + [[Image:info.png]] You may recognize the Tray2 monad as a disguised version of the Error monad that is a standard part of the Haskell 98 libraries.
- Replacing the Tray monad with the Tray2 monad instantly upgrades your assembly line. Now when a failure occurs, the tray that is brought to the quality control engineer contains a failure report detailing the exact cause of the failure! + Replacing the Tray monad with the Tray2 monad instantly upgrades your assembly line. Now when a failure occurs, the tray that is brought to the quality control engineer contains a failure report detailing the exact cause of the failure! - + - + - ----- + - + - + -
+ - + - + - + - + - + - + - + Haskell code examples Haskell code examples - - -
Prev: [[analogy.html|Appendix I - A physical analogy for monads]]TOC: [[index.html|Contents]]
Prev: [[analogy.html|Apendix I - A physical analogy for monads]]TOC: [[index.html|Contents]]
+ [[Category:Standard types]] - + [[Category:Tutorials]] - + - + - + - + - + - +

## Revision as of 04:59, 27 February 2013

Attempts are being made at porting the tutorial to this wiki; what you're seeing below is a preview of the result of that effort. If you wish to help out you should fork this GitHub repo rather than edit this page, for now.

# 1 Introduction

## 1.1 What is a monad?

A monad is a way to structure computations in terms of values and sequences of computations using those values. Monads allow the programmer to build up computations using sequential building blocks, which can themselves be sequences of computations. The monad determines how combined computations form a new computation and frees the programmer from having to code the combination manually each time it is required.

It is useful to think of a monad as a strategy for combining computations into more complex computations. For example, you should be familiar with the `Maybe` type in Haskell:

`data Maybe a = Nothing | Just a`

which represents the type of computations which may fail to return a result. The `Maybe` type suggests a strategy for combining computations which return `Maybe` values: if a combined computation consists of one computation `B` that depends on the result of another computation `A`, then the combined computation should yield `Nothing` whenever either `A` or `B` yield `Nothing` and the combined computation should yield the result of `B` applied to the result of `A` when both computations succeed.

Other monads exist for building computations that perform I/O, have state, may return multiple results, etc. There are as many different type of monads as there are strategies for combining computations, but there are certain monads that are especially useful and are common enough that they are part of the standard Haskell 98 libraries. These monads are each described in Part II.

## 1.2 Why should I make the effort to understand monads?

The sheer number of different monad tutorials on the internet is a good indication of the difficulty many people have understanding the concept. This is due to the abstract nature of monads and to the fact that they are used in several different capacities, which can confuse the picture of exactly what a monad is and what it is good for.

For the programmer, monads are useful tools for structuring functional programs. They have three properties that make them especially useful:

1. Modularity - They allow computations to be composed from simpler computations and separate the combination strategy from the actual computations being performed.
2. Flexibility - They allow functional programs to be much more adaptable than equivalent programs written without monads. This is because the monad distills the computational strategy into a single place instead of requiring it be distributed throughout the entire program.
3. Isolation - They can be used to create imperative-style computational structures which remain safely isolated from the main body of the functional program. This is useful for incorporating side-effects (such as I/O) and state (which violates referential transparency) into a pure functional language like Haskell.

Each of these features will be revisited later in the tutorial in the context of specific monads.

We will use the `Maybe` type constructor throughout this chapter, so you should familiarize yourself with the definition and usage of `Maybe` before continuing.

## 2.1 Type constructors

To understand monads in Haskell, you need to be comfortable dealing with type constructors. A type constructor is a parameterized type definition used with polymorphic types. By supplying a type constructor with one or more concrete types, you can construct a new concrete type in Haskell. In the definition of `Maybe`:

`data Maybe a = Nothing | Just a`

`Maybe` is a type constructor and `Nothing` and `Just` are data constructors. You can construct a data value by applying the `Just` data constructor to a value:

`country = Just "China"`

In the same way, you can construct a type by applying the `Maybe` type constructor to a type:

`lookupAge :: DB -> String -> Maybe Int`

Polymorphic types are like containers that are capable of holding values of many different types. So `Maybe Int` can be thought of as a `Maybe` container holding an `Int` value (or `Nothing`) and `Maybe String` would be a `Maybe` container holding a `String` value (or `Nothing`). In Haskell, we can also make the type of the container polymorphic, so we could write "`m a`" to represent a container of some type holding a value of some type!

We often use type variables with type constructors to describe abstract features of a computation. For example, the polymorphic type `Maybe a` is the type of all computations that may return a value or `Nothing`. In this way, we can talk about the properties of the container apart from any details of what the container might hold.

Image:Info.png If you get messages about "kind errors" from the compiler when working with monads, it means that you are not using the type constructors correctly.

In Haskell a monad is represented as a type constructor (call it `m`), a function that builds values of that type (`a -> m a`), and a function that combines values of that type with computations that produce values of that type to produce a new computation for values of that type (`m a -> (a -> m b) -> m b`). Note that the container is the same, but the type of the contents of the container can change. It is customary to call the monad type constructor "`m`" when discussing monads in general. The function that builds values of that type is traditionally called "`return`" and the third function is known as "bind" but is written "`>>=`". The signatures of the functions are:

```-- the type of monad m
data m a = ...

-- return is a type constructor that creates monad instances
return :: a -> m a

-- bind is a function that combines a monad instance m a with a computation
-- that produces another monad instance m b from a's to produce a new
(>>=) :: m a -> (a -> m b) -> m b```

Roughly speaking, the monad type constructor defines a type of computation, the `return` function creates primitive values of that computation type and `>>=` combines computations of that type together to make more complex computations of that type. Using the container analogy, the type constructor `m` is a container that can hold different values. `m a` is a container holding a value of type `a`. The `return` function puts a value into a monad container. The `>>=` function takes the value from a monad container and passes it to a function to produce a monad container containing a new value, possibly of a different type. The `>>=` function is known as "bind" because it binds the value in a monad container to the first argument of a function. By adding logic to the binding function, a monad can implement a specific strategy for combining computations in the monad.

This will all become clearer after the example below, but if you feel particularly confused at this point you might try looking at this physical analogy of a monad before continuing.

## 2.3 An example

Suppose that we are writing a program to keep track of sheep cloning experiments. We would certainly want to know the genetic history of all of our sheep, so we would need `mother` and `father` functions. But since these are cloned sheep, they may not always have both a mother and a father!

We would represent the possibility of not having a mother or father using the `Maybe` type constructor in our Haskell code:

```type Sheep = ...

father :: Sheep -> Maybe Sheep
father = ...

mother :: Sheep -> Maybe Sheep
mother = ...```

Then, defining functions to find grandparents is a little more complicated, because we have to handle the possibility of not having a parent:

```maternalGrandfather :: Sheep -> Maybe Sheep
maternalGrandfather s = case (mother s) of
Nothing -> Nothing
Just m  -> father m```

and so on for the other grandparent combinations.

It gets even worse if we want to find great grandparents:

```mothersPaternalGrandfather :: Sheep -> Maybe Sheep
mothersPaternalGrandfather s = case (mother s) of
Nothing -> Nothing
Just m  -> case (father m) of
Nothing -> Nothing
Just gf -> father gf```

Aside from being ugly, unclear, and difficult to maintain, this is just too much work. It is clear that a `Nothing` value at any point in the computation will cause `Nothing` to be the final result, and it would be much nicer to implement this notion once in a single place and remove all of the explicit `case` testing scattered all over the code. This will make the code easier to write, easier to read and easier to change. So good programming style would have us create a combinator that captures the behavior we want:

Code available in [[../examples/example1.hs|example1.hs]]

```-- comb is a combinator for sequencing operations that return Maybe
comb :: Maybe a -> (a -> Maybe b) -> Maybe b
comb Nothing  _ = Nothing
comb (Just x) f = f x

-- now we can use `comb` to build complicated sequences
mothersPaternalGrandfather :: Sheep -> Maybe Sheep
mothersPaternalGrandfather s = (Just s) `comb` mother `comb` father `comb` father```

The combinator is a huge success! The code is much cleaner and easier to write, understand and modify. Notice also that the `comb` function is entirely polymorphic — it is not specialized for `Sheep` in any way. In fact, the combinator captures a general strategy for combining computations that may fail to return a value. Thus, we can apply the same combinator to other computations that may fail to return a value, such as database queries or dictionary lookups.

The happy outcome is that common sense programming practice has led us to create a monad without even realizing it. The `Maybe` type constructor along with the `Just` function (acts like `return`) and our combinator (acts like `>>=`) together form a simple monad for building computations which may not return a value. All that remains to make this monad truly useful is to make it conform to the monad framework built into the Haskell language. That is the subject of the next chapter.

## 2.4 A list is also a monad

We have seen that the `Maybe` type constructor is a monad for building computations which may fail to return a value. You may be surprised to know that another common Haskell type constructor, `[]` (for building lists), is also a monad. The List monad allows us to build computations which can return 0, 1, or more values.

The `return` function for lists simply creates a singleton list (`return x = [x]`). The binding operation for lists creates a new list containing the results of applying the function to all of the values in the original list (`l >>= f = concatMap f l`).

One use of functions which return lists is to represent ambiguous computations — that is computations which may have 0, 1, or more allowed outcomes. In a computation composed from ambigous subcomputations, the ambiguity may compound, or it may eventually resolve into a single allowed outcome or no allowed outcome at all. During this process, the set of possible computational states is represented as a list. The List monad thus embodies a strategy for performing simultaneous computations along all allowed paths of an ambiguous computation.

Examples of this use of the List monad, and contrasting examples using the Maybe monad will be presented shortly. But first, we must see how useful monads are defined in Haskell.

## 2.5 Summary

We have seen that a monad is a type constructor, a function called `return`, and a combinator function called `bind` or `>>=`. These three elements work together to encapsulate a strategy for combining computations to produce more complex computations.

Using the `Maybe` type constructor, we saw how good programming practice led us to define a simple monad that could be used to build complex computations out of sequences of computations that could each fail to return a value. The resulting `Maybe` monad encapsulates a strategy for combining computations that may not return values. By codifying the strategy in a monad, we have achieved a degree of modularity and flexibility that is not present when the computations are combined in an ad hoc manner.

We have also seen that another common Haskell type constructor, `[]`, is a monad. The List monad encapsulates a strategy for combining computations that can return 0, 1, or multiple values.

Doing it with class

# 3 Doing it with class

The discussion in this chapter involves the Haskell type class system. If you are not familiar with type classes in Haskell, you should review them before continuing.

In Haskell, there is a standard `Monad` class that defines the names and signatures of the two monad functions `return` and `>>=`. It is not strictly necessary to make your monads instances of the `Monad` class, but it is a good idea. Haskell has special support for `Monad` instances built into the language and making your monads instances of the `Monad` class will allow you to use these features to write cleaner and more elegant code. Also, making your monads instances of the `Monad` class communicates important information to others who read the code and failing to do so can cause you to use confusing and non-standard function names. It's easy to do and it has many benefits, so just do it!

The standard `Monad` class definition in Haskell looks something like this:

```class Monad m where
(>>=)  :: m a -> (a -> m b) -> m b
return :: a -> m a```

## 3.3 Example continued

Continuing the previous example, we will now see how the `Maybe` type constructor fits into the Haskell monad framework as an instance of the `Monad` class.

Recall that our `Maybe` monad used the `Just` data constructor to fill the role of the monad `return` function and we built a simple combinator to fill the role of the monad `>>=` binding function. We can make its role as a monad explicit by declaring `Maybe` as an instance of the `Monad` class:

```instance Monad Maybe where
Nothing  >>= f = Nothing
(Just x) >>= f = f x
return         = Just```

Once we have defined `Maybe` as an instance of the Monad class, we can use the standard monad operators to build the complex computations:

```-- we can use monadic operations to build complicated sequences
maternalGrandfather :: Sheep -> Maybe Sheep
maternalGrandfather s = (return s) >>= mother >>= father

fathersMaternalGrandmother :: Sheep -> Maybe Sheep
fathersMaternalGrandmother s = (return s) >>= father >>= mother >>= mother```

In Haskell, `Maybe` is defined as an instance of the `Monad` class in the standard prelude, so you don't need to do it yourself. The other monad we have seen so far, the list constructor, is also defined as an instance of the `Monad` class in the standard prelude.

Image:Info.png When writing functions that work with monads, try to make use of the `Monad` class instead of using a specific monad instance. A function of the type

`doSomething :: (Monad m) => a -> m b`

is much more flexible than one of the type

`doSomething :: a -> Maybe b`

The former function can be used with many types of monads to get different behavior depending on the strategy embodied in the monad, whereas the latter function is restricted to the strategy of the `Maybe` monad.

## 3.4 Do notation

Using the standard monadic function names is good, but another advantage of membership in the `Monad` class is the Haskell support for "do" notation. Do notation is an expressive shorthand for building up monadic computations, similar to the way that list comprehensions are an expressive shorthand for building computations on lists. Any instance of the `Monad` class can be used in a do-block in Haskell.

In short, the do notation allows you to write monadic computations using a pseudo-imperative style with named variables. The result of a monadic computation can be "assigned" to a variable using a left arrow `<-` operator. Then using that variable in a subsequent monadic computation automatically performs the binding. The type of the expression to the right of the arrow is a monadic type `m a`. The expression to the left of the arrow is a pattern to be matched against the value inside the monad. `(x:xs)` would match against `Maybe [1,2,3]`, for example.

Here is a sample of do notation using the `Maybe` monad:

Code available in [[../examples/example2.hs|example2.hs]]

```-- we can also use do-notation to build complicated sequences
mothersPaternalGrandfather :: Sheep -> Maybe Sheep
mothersPaternalGrandfather s = do m  <- mother s
gf <- father m
father gf```

Compare this to `fathersMaternalGrandmother` written above without using do notation.

The do block shown above is written using the layout rule to define the extent of the block. Haskell also allows you to use braces and semicolons when defining a do block:

`mothersPaternalGrandfather s = do { m <- mother s; gf <- father m; father gf }`

Notice that do notation resembles an imperative programming language, in which a computation is built up from an explicit sequence of simpler computations. In this respect, monads offer the possibility to create imperative-style computations within a larger functional program. This theme will be expanded upon when we deal with side-effects and the I/O monad later.

Do notation is simply syntactic sugar. There is nothing that can be done using do notation that cannot be done using only the standard monadic operators. But do notation is cleaner and more convenient in some cases, especially when the sequence of monadic computations is long. You should understand both the standard monadic binding notation and do notation and be able to apply each where they are appropriate.

The actual translation from do notation to standard monadic operators is roughly that every expression matched to a pattern, `x <- expr1`, becomes

`expr1 >>= \x ->`

and every expression without a variable assignment, `expr2` becomes

`expr2 >>= \_ ->`

All do blocks must end with a monadic expression, and a let clause is allowed at the beginning of a do block (but let clauses in do blocks do not use the "in" keyword). The definition of `mothersPaternalGrandfather` above would be translated to:

```mothersPaternalGrandfather s = mother s >>= \m ->
father m >>= \gf ->
father gf```

It now becomes clear why the binding operator is so named. It is literally used to bind the value in the monad to the argument in the following lambda expression.

## 3.5 Summary

Haskell provides built-in support for monads. To take advantage of Haskell's monad support, you must declare the monad type constructor to be an instance of the `Monad` class and supply definitions of the `return` and `>>=` (pronounced "bind") functions for the monad.

A monad that is an instance of the `Monad` class can be used with do-notation, which is syntactic sugar that provides a simple, imperative-style notation for describing computations with monads.

The tutorial up to now has avoided technical discussions, but there are a few technical points that must be made concerning monads. Monadic operations must obey a set of laws, known as "the monad axioms". These laws aren't enforced by the Haskell compiler, so it is up to the programmer to ensure that any `Monad` instances they declare obey the laws. Haskell's `Monad` class also includes some functions beyond the minimal complete definition that we have not seen yet. Finally, many monads obey additional laws beyond the standard monad laws, and there is an additional Haskell class to support these extended monads.

## 4.1 The three fundamental laws

The concept of a monad comes from a branch of mathematics called category theory. While it is not necessary to know category theory to create and use monads, we do need to obey a small bit of mathematical formalism. To create a monad, it is not enough just to declare a Haskell instance of the `Monad` class with the correct type signatures. To be a proper monad, the `return` and `>>=` functions must work together according to three laws:

1. `(return x) >>= f == f x`
2. `m >>= return == m`
3. `(m >>= f) >>= g == m >>= (\x -> f x >>= g)`

The first law requires that `return` is a left-identity with respect to `>>=`. The second law requires that `return` is a right-identity with respect to `>>=`. The third law is a kind of associativity law for `>>=`. Obeying the three laws ensures that the semantics of the do-notation using the monad will be consistent.

Any type constructor with return and bind operators that satisfy the three monad laws is a monad. In Haskell, the compiler does not check that the laws hold for every instance of the `Monad` class. It is up to the programmer to ensure that any `Monad` instance they create satisfies the monad laws.

## 4.2 Failure IS an option

The definition of the `Monad` class given earlier showed only the minimal complete definition. The full definition of the `Monad` class actually includes two additional functions: `fail` and `>>`.

The default implementation of the `fail` function is:

`fail s = error s`

You do not need to change this for your monad unless you want to provide different behavior for failure or to incorporate failure into the computational strategy of your monad. The `Maybe` monad, for instance, defines `fail` as:

`fail _ = Nothing`

so that `fail` returns an instance of the `Maybe` monad with meaningful behavior when it is bound with other functions in the `Maybe` monad.

The `fail` function is not a required part of the mathematical definition of a monad, but it is included in the standard `Monad` class definition because of the role it plays in Haskell's do notation. The `fail` function is called whenever a pattern matching failure occurs in a do block:

```fn :: Int -> Maybe [Int]
fn idx = do let l = [Just [1,2,3], Nothing, Just [], Just [7..20]]
(x:xs) <- l!!idx   -- a pattern match failure will call "fail"
return xs```

So in the code above, `fn 0` has the value `Just [2,3]`, but `fn 1` and `fn 2` both have the value `Nothing`.

The `>>` function is a convenience operator that is used to bind a monadic computation that does not require input from the previous computation in the sequence. It is defined in terms of `>>=`:

```(>>) :: m a -> m b -> m b
m >> k = m >>= (\_ -> k)```

## 4.3 No way out

You might have noticed that there is no way to get values out of a monad as defined in the standard `Monad` class. That is not an accident. Nothing prevents the monad author from allowing it using functions specific to the monad. For instance, values can be extracted from the `Maybe` monad by pattern matching on `Just x` or using the `fromJust` function.

By not requiring such a function, the Haskell `Monad` class allows the creation of one-way monads. One-way monads allow values to enter the monad through the `return` function (and sometimes the `fail` function) and they allow computations to be performed within the monad using the bind functions `>>=` and `>>`, but they do not allow values back out of the monad.

The `IO` monad is a familiar example of a one-way monad in Haskell. Because you can't escape from the `IO` monad, it is impossible to write a function that does a computation in the `IO` monad but whose result type does not include the `IO` type constructor. This means that any function whose result type does not contain the `IO` type constructor is guaranteed not to use the `IO` monad. Other monads, such as `List` and `Maybe`, do allow values out of the monad. So it is possible to write functions which use these monads internally but return non-monadic values.

The wonderful feature of a one-way monad is that it can support side-effects in its monadic operations but prevent them from destroying the functional properties of the non-monadic portions of the program.

Consider the simple issue of reading a character from the user. We cannot simply have a function `readChar :: Char`, because it needs to return a different character each time it is called, depending on the input from the user. It is an essential property of Haskell as a pure functional language that all functions return the same value when called twice with the same arguments. But it is ok to have an I/O function `getChar :: IO Char` in the `IO` monad, because it can only be used in a sequence within the one-way monad. There is no way to get rid of the `IO` type constructor in the signature of any function that uses it, so the `IO` type constructor acts as a kind of tag that identifies all functions that do I/O. Furthermore, such functions are only useful within the `IO` monad. So a one-way monad effectively creates an isolated computational domain in which the rules of a pure functional language can be relaxed. Functional computations can move into the domain, but dangerous side-effects and non-referentially-transparent functions cannot escape from it.

Another common pattern when defining monads is to represent monadic values as functions. Then when the value of a monadic computation is required, the resulting monad is "run" to provide the answer.

## 4.4 Zero and Plus

Beyond the three monad laws stated above, some monads obey additional laws. The monads have a special value `mzero` and an operator `mplus` that obey four additional laws:

1. `mzero >>= f == mzero`
2. `m >>= (\x -> mzero) == mzero`
3. `mzero `mplus` m == m`
4. `m `mplus` mzero == m`

It is easy to remember the laws for `mzero` and `mplus` if you associate `mzero` with 0, `mplus` with +, and `>>=` with × in ordinary arithmetic.

Monads which have a zero and a plus can be declared as instances of the `MonadPlus` class in Haskell:

```class (Monad m) => MonadPlus m where
mzero :: m a
mplus :: m a -> m a -> m a```

Continuing to use the `Maybe` monad as an example, we see that the `Maybe` monad is an instance of `MonadPlus`:

```instance MonadPlus Maybe where
mzero             = Nothing
Nothing `mplus` x = x
x `mplus` _       = x```

This identifies `Nothing` as the zero value and says that adding two `Maybe` values together gives the first value that is not `Nothing`. If both input values are `Nothing`, then the result of `mplus` is also `Nothing`.

The List monad also has a zero and a plus. `mzero` is the empty list and `mplus` is the `++` operator.

The `mplus` operator is used to combine monadic values from separate computations into a single monadic value. Within the context of our sheep-cloning example, we could use `Maybe`'s `mplus` to define a function, `parent s = (mother s) `mplus` (father s)`, which would return a parent if there is one, and `Nothing` is the sheep has no parents at all. For a sheep with both parents, the function would return one or the other, depending on the exact definition of `mplus` in the `Maybe` monad.

## 4.5 Summary

Instances of the `Monad` class should conform to the so-called monad laws, which describe algabraic properties of monads. There are three of these laws which state that the `return` function is both a left and a right identity and that the binding operator is associative. Failure to satisfy these laws will result in monads that do not behave properly and may cause subtle problems when using do-notation.

In addition to the `return` and `>>=` functions, the `Monad` class defines another function, `fail`. The `fail` function is not a technical requirement for inclusion as a monad, but it is often useful in practice and it is included in the `Monad` class because it is used in Haskell's do-notation.

Some monads obey laws beyond the three basic monad laws. An important class of such monads are ones which have a notion of a zero element and a plus operator. Haskell provides a `MonadPlus` class for such monads which define the `mzero` value and the `mplus` operator.

Exercises

# 5 Exercises

This section contains a few simple exercises to hone the reader's monadic reasoning skills and to provide a solid comprehension of the function and use of the Maybe and List monads before looking at monadic programming in more depth. The exercises will build on the previous sheep-cloning [[../examples/example2.hs|example]], with which the reader should already be familiar.

## 5.1 Exercise 1: Do notation

Rewrite the `maternalGrandfather`, `fathersMaternalGrandmother`, and `mothersPaternalGrandfather` functions in [[../examples/example2.hs|Example 2]] using the monadic operators `return` and `>>=`, without using any do-notation syntactic sugar.

## 5.2 Exercise 2: Combining monadic values

Write functions `parent` and `grandparent` with signature `Sheep -> Maybe Sheep`. They should return one sheep selected from all sheep matching the description, or `Nothing` if there is no such sheep. Hint: the `mplus` operator is useful here.

## 5.3 Exercise 3: Using the List monad

Write functions `parent` and `grandparent` with signature `Sheep -> [Sheep]`. They should return all sheep matching the description, or the empty list if there is no such sheep. Hint: the `mplus` operator in the List monad is useful here. Also the `maybeToList` function in the `Maybe` module can be used to convert a value from the Maybe monad to the List monad.

## 5.4 Exercise 4: Using the Monad class constraint

Monads promote modularity and code reuse by encapsulating often-used computational strategies into single blocks of code that can be used to construct many different computations. Less obviously, monads also promote modularity by allowing you to vary the monad in which a computation is done to achieve different variations of the computation. This is achieved by writing functions which are polymorphic in the monad type constructor, using the `(Monad m) =>`, `(MonadPlus m) =>`, etc. class constraints.

Write functions `parent` and `grandparent` with signature `(MonadPlus m) => Sheep -> m Sheep`. They should be useful in both the Maybe and List monads. How does the functions' behavior differ when used with the List monad versus the Maybe monad? If you need to review the use of type classes and class constraints in Haskell, look here.

Haskell's built in support for monads is split among the standard prelude, which exports the most common monad functions, and the Monad module, which contains less-commonly used monad functions. The individual monad types are each in their own libraries and are the subject of Part II of this tutorial.

## 6.1 In the standard prelude

The Haskell 98 standard prelude includes the definition of the `Monad` class as well as a few auxilliary functions for working with monadic data types.

### 6.1.1 The `Monad` class

We have seen the `Monad` class before:

```class  Monad m  where
(>>=)  :: m a -> (a -> m b) -> m b
(>>)   :: m a -> m b -> m b
return :: a -> m a
fail   :: String -> m a

-- Minimal complete definition:
--      (>>=), return
m >> k  =  m >>= \_ -> k
fail s  = error s```

### 6.1.2 The sequencing functions

The `sequence` function takes a list of monadic computations, executes each one in turn and returns a list of the results. If any of the computations fail, then the whole function fails:

```sequence :: Monad m => [m a] -> m [a]
sequence = foldr mcons (return [])
where mcons p q = p >>= \x -> q >>= \y -> return (x:y)```

The `sequence_` function (notice the underscore) has the same behavior as `sequence` but does not return a list of results. It is useful when only the side-effects of the monadic computations are important.

```sequence_ :: Monad m => [m a] -> m ()
sequence_ = foldr (>>) (return ())```

### 6.1.3 The mapping functions

The `mapM` function maps a monadic computation over a list of values and returns a list of the results. It is defined in terms of the list `map` function and the `sequence` function above:

```mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f as = sequence (map f as)```

There is also a version with an underscore, `mapM_` which is defined using sequence_. `mapM_` operates the same as `mapM`, but it doesn't return the list of values. It is useful when only the side-effects of the monadic computation are important.

```mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
mapM_ f as = sequence_ (map f as)```

As a simple example of the use the mapping functions, a `putString` function for the `IO` monad could be defined as:

```putString :: [Char] -> IO ()
putString s = mapM_ putChar s```

`mapM` can be used within a do block in a manner similar to the way the `map` function is normally used on lists. This is a common pattern with monads — a version of a function for use within a monad (i.e., intended for binding) will have a signature similar to the non-monadic version but the function outputs will be within the monad:

```-- compare the non-monadic and monadic signatures
map  ::            (a -> b)   -> [a] -> [b]
mapM :: Monad m => (a -> m b) -> [a] -> m [b]```

### 6.1.4 The reverse binder function (`=<<`)

The prelude also defines a binding function that takes it arguments in the opposite order to the standard binding function. Since the standard binding function is called "`>>=`", the reverse binding function is called "`=<<`". It is useful in circumstances where the binding operator is used as a higher-order term and it is more convenient to have the arguments in the reversed order. Its definition is simply:

```(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f```

## 6.2 In the Monad module

The `Monad` module in the standard Haskell 98 libraries exports a number of facilities for more advanced monadic operations. To access these facilities, simply `import Monad` in your Haskell program.

Not all of the function in the `Monad` module are discussed here, but you are encouraged to explore the module for yourself when you feel you are ready to see some of the more esoteric monad functions.

### 6.2.1 The `MonadPlus` class

The `Monad` module defines the `MonadPlus` class for monads with a zero element and a plus operator:

```class Monad m => MonadPlus m where
mzero :: m a
mplus :: m a -> m a -> m a```

### 6.2.2 Monadic versions of list functions

Several functions are provided which generalize standard list-processing functions to monads. The `mapM` functions are exported in the standard prelude and were described above.

`foldM` is a monadic version of `foldl` in which monadic computations built from a list are bound left-to-right. The definition is:

```foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM f a []     = return a
foldM f a (x:xs) = f a x >>= \y -> foldM f y xs```

but it is easier to understand the operation of `foldM` if you consider its effect in terms of a do block:

```-- this is not valid Haskell code, it is just for illustration
foldM f a1 [x1,x2,...,xn] = do a2 <- f a1 x1
a3 <- f a2 x2
...
f an xn```

Right-to-left binding is achieved by reversing the input list before calling `foldM`.

We can use `foldM` to create a more poweful query function in our sheep cloning example:

Code available in [[../examples/example3.hs|example3.hs]]

```-- traceFamily is a generic function to find an ancestor
traceFamily :: Sheep -> [ (Sheep -> Maybe Sheep) ] -> Maybe Sheep
traceFamily s l = foldM getParent s l
where getParent s f = f s

-- we can define complex queries using traceFamily in an easy, clear way
mothersPaternalGrandfather s = traceFamily s [mother, father, father]
paternalGrandmother s = traceFamily s [father, mother]```

The `traceFamily` function uses `foldM` to create a simple way to trace back in the family tree to any depth and in any pattern. In fact, it is probably clearer to write "`traceFamily s [father, mother]`" than it is to use the `paternalGrandmother` function!

A more typical use of `foldM` is within a do block:

Code available in [[../examples/example4.hs|example4.hs]]

```-- a Dict is just a finite map from strings to strings
type Dict = FiniteMap String String

-- this an auxilliary function used with foldl
addEntry :: Dict -> Entry -> Dict

-- this is an auxiliiary function used with foldM inside the IO monad
addDataFromFile :: Dict -> Handle -> IO Dict
addDataFromFile dict hdl = do contents <- hGetContents hdl
entries  <- return (map read (lines contents))

-- this program builds a dictionary from the entries in all files named on the
-- command line and then prints it out as an association list
main :: IO ()
main = do files   <- getArgs
dict    <- foldM addDataFromFile emptyFM handles
print (fmToList dict)```

The `filterM` function works like the list `filter` function inside of a monad. It takes a predicate function which returns a Boolean value in the monad and a list of values. It returns, inside the monad, a list of those values for which the predicate was True.

```filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
filterM p []     = return []
filterM p (x:xs) = do b  <- p x
ys <- filterM p xs
return (if b then (x:ys) else ys)```

Here is an example showing how `filterM` can be used within the `IO` monad to select only the directories from a list:

Code available in [[../examples/example5.hs|example5.hs]]

```import Monad
import Directory
import System

-- NOTE: doesDirectoryExist has type FilePath -> IO Bool

-- this program prints only the directories named on the command line
main :: IO ()
main = do names <- getArgs
dirs  <- filterM doesDirectoryExist names
mapM_ putStrLn dirs```

`zipWithM` is a monadic version of the `zipWith` function on lists. `zipWithM_` behaves the same but discards the output of the function. It is useful when only the side-effects of the monadic computation matter.

```zipWithM ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM f xs ys = sequence (zipWith f xs ys)

zipWithM_ ::(Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ f xs ys = sequence_ (zipWith f xs ys)```

There are two functions provided for conditionally executing monadic computations. The `when` function takes a boolean argument and a monadic computation with unit "()" type and performs the computation only when the boolean argument is `True`. The `unless` function does the same, except that it performs the computation unless the boolean argument is `True`.

```when :: (Monad m) => Bool -> m () -> m ()
when p s = if p then s else return ()

unless :: (Monad m) => Bool -> m () -> m ()
unless p s = when (not p) s```

### 6.2.4 `ap` and the lifting functions

Lifting is a monadic operation that converts a non-monadic function into an equivalent function that operates on monadic values. We say that a function is "lifted into the monad" by the lifting operators. A lifted function is useful for operating on monad values outside of a do block and can also allow for cleaner code within a do block.

The simplest lifting operator is `liftM`, which lifts a function of a single argument into a monad.

```liftM :: (Monad m) => (a -> b) -> (m a -> m b)
liftM f = \a -> do { a' <- a; return (f a') }```

Lifting operators are also provided for functions with more arguments. `liftM2` lifts functions of two arguments:

```liftM2 :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
liftM2 f = \a b -> do { a' <- a; b' <- b; return (f a' b') }```

The same pattern is applied to give the definitions to lift functions of more arguments. Functions up to `liftM5` are defined in the `Monad` module.

To see how the lifting operators allow more concise code, consider a computation in the `Maybe` monad in which you want to use a function `swapNames::String -> String`. You could do:

```getName :: String -> Maybe String
getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")]
tempName <- lookup name db
return (swapNames tempName)```

But making use of the `liftM` function, we can use `liftM swapNames` as a function of type `Maybe String -> Maybe String`:

Code available in [[../examples/example6.hs|example6.hs]]

```getName :: String -> Maybe String
getName name = do let db = [("John", "Smith, John"), ("Mike", "Caine, Michael")]
liftM swapNames (lookup name db)```

The difference is even greater when lifting functions with more arguments.

The lifting functions also enable very concise constructions using higher-order functions. To understand this example code, you might need to review the definition of the monad functions for the List monad (particularly `>>=`). Imagine how you might implement this function without lifting the operator:

Code available in [[../examples/example7.hs|example7.hs]]

```-- allCombinations returns a list containing the result of
-- folding the binary operator through all combinations
-- of elements of the given lists
-- For example, allCombinations (+) [[0,1],[1,2,3]] would be
--   [0+1,0+2,0+3,1+1,1+2,1+3], or [1,2,3,2,3,4]
-- and allCombinations (*) [[0,1],[1,2],[3,5]] would be
--   [0*1*3,0*1*5,0*2*3,0*2*5,1*1*3,1*1*5,1*2*3,1*2*5], or [0,0,0,0,3,5,6,10]
allCombinations :: (a -> a -> a) -> [[a]] -> [a]
allCombinations fn []     = []
allCombinations fn (l:ls) = foldl (liftM2 fn) l ls```

There is a related function called `ap` that is sometimes more convenient to use than the lifting functions. `ap` is simply the function application operator (`\$`) lifted into the monad:

```ap :: (Monad m) => m (a -> b) -> m a -> m b
ap = liftM2 (\$)```

Note that `liftM2 f x y` is equivalent to `return f `ap` x `ap` y`, and so on for functions of more arguments. `ap` is useful when working with higher-order functions and monads.

The effect of `ap` depends on the strategy of the monad in which it is used. So for example `[(*2),(+3)] `ap` [0,1,2]` is equal to `[0,2,4,3,4,5]` and `(Just (*2)) `ap` (Just 3)` is `Just 6`. Here is a simple example that shows how `ap` can be useful when doing higher-order computations:

Code available in [[../examples/example8.hs|example8.hs]]

```-- lookup the commands and fold ap into the command list to
-- compute a result.
main :: IO ()
main = do let fns  = [("double",(2*)),      ("halve",(`div`2)),
("square",(\x->x*x)), ("negate", negate),
("incr",(+1)),        ("decr",(+(-1)))
]
args <- getArgs
cmds = map ((flip lookup) fns) (words (args!!1))
print \$ foldl (flip ap) (Just val) cmds```

### 6.2.5 Functions for use with `MonadPlus`

There are two functions in the `Monad` module that are used with monads that have a zero and a plus. The first function is `msum`, which is analogous to the `sum` function on lists of integers. `msum` operates on lists of monadic values and folds the `mplus` operator into the list using the `mzero` element as the initial value:

```msum :: MonadPlus m => [m a] -> m a
msum xs = foldr mplus mzero xs```

In the List monad, `msum` is equivalent to `concat`. In the `Maybe` monad, `msum` returns the first non-`Nothing` value from a list. Likewise, the behavior in other monads will depend on the exact nature of their `mzero` and `mplus` definitions.

`msum` allows many recursive functions and folds to be expressed more concisely. In the `Maybe` monad, for example, we can write:

Code available in [[../examples/example9.hs|example9.hs]]

```type Variable = String
type Value = String
type EnvironmentStack = [[(Variable,Value)]]

-- lookupVar retrieves a variable's value from the environment stack
-- It uses msum in the Maybe monad to return the first non-Nothing value.
lookupVar :: Variable -> EnvironmentStack -> Maybe Value
lookupVar var stack = msum \$ map (lookup var) stack```

```lookupVar :: Variable -> EnvironmentStack -> Maybe Value
lookupVar var []     = Nothing
lookupVar var (e:es) = let val = lookup var e
in maybe (lookupVar var es) Just val```

The second function for use with monads with a zero and a plus is the `guard` function:

```guard :: MonadPlus m => Bool -> m ()
guard p = if p then return () else mzero```

The trick to understanding this function is to recall the law for monads with zero and plus that states `mzero >>= f == mzero`. So, placing a `guard` function in a sequence of monadic operations will force any execution in which the guard is `False` to be `mzero`. This is similar to the way that guard predicates in a list comprehension cause values that fail the predicate to become `[]`.

Here is an example demonstrating the use of the `guard` function in the `Maybe` monad.

Code available in [[../examples/example10.hs|example10.hs]]

```data Record = Rec {name::String, age::Int} deriving Show
type DB = [Record]

-- getYoungerThan returns all records for people younger than a specified age.
-- It uses the guard function to eliminate records for ages at or over the limit.
-- This is just for demonstration purposes.  In real life, it would be
-- clearer to simply use filter.  When the filter criteria are more complex,
-- guard becomes more useful.
getYoungerThan :: Int -> DB -> [Record]
getYoungerThan limit db = mapMaybe (\r -> do { guard (age r < limit); return r }) db```

## 6.3 Summary

Haskell provides a number of functions which are useful for working with monads in the standard libraries. The `Monad` class and most common monad functions are in the standard prelude. The `MonadPlus` class and less commonly-used (but still very useful!) functions are defined in the `Monad` module. Many other types in the Haskell libraries are declared as instances of `Monad` and `MonadPlus` in their respective modules.

Part II - Introduction

# 7 Introduction

Some of the documentation for these monads comes from the excellent Haskell Wiki. In addition to the monads covered here, monads appear many other places in Haskell, such as the Parsec monadic combinator parsing library. These monads are beyond the scope of this reference, but they are thoroughly documented on their own. You can get a taste of the Parsec library by looking in the [[../examples/example16.hs|source code]] for example 16.

Monad Type of computation Combination strategy for `>>=`
Identity N/A — Used with monad transformers The bound function is applied to the input value.
Maybe Computations which may not return a result `Nothing` input gives `Nothing` output
`Just x` input uses `x` as input to the bound function.
Error Computations which can fail or throw exceptions Failure records information describing the failure. Binding passes failure information on without executing the bound function, or uses successful values as input to the bound function.
[] (List) Non-deterministic computations which can return multiple possible results Maps the bound function onto the input list and concatenates the resulting lists to get a list of all possible results from all possible inputs.
IO Computations which perform I/O Sequential execution of I/O actions in the order of binding.
State Computations which maintain state The bound function is applied to the input value to produce a state transition function which is applied to the input state.
Reader Computations which read from a shared environment The bound function is applied to the value of the input using the same environment.
Writer Computations which write data in addition to computing values Written data is maintained separately from values. The bound function is applied to the input value and anything it writes is appended to the write data stream.
Cont Computations which can be interrupted and restarted The bound function is inserted into the continuation chain.

## 8.1 Overview

Computation type:

Simple function application

Binding strategy:

The bound function is applied to the input value. `Identity x >>= f == Identity (f x)`

Useful for:

Zero and plus:

None.

Example type:

## 8.2 Motivation

The Identity monad is a monad that does not embody any computational strategy. It simply applies the bound function to its input without any modification. Computationally, there is no reason to use the Identity monad instead of the much simpler act of simply applying functions to their arguments. The purpose of the Identity monad is its fundamental role in the theory of monad transformers (covered in Part III). Any monad transformer applied to the Identity monad yields a non-transformer version of that monad.

## 8.3 Definition

```newtype Identity a = Identity { runIdentity :: a }

return a           = Identity a   -- i.e. return = id
(Identity x) >>= f = f x          -- i.e. x >>= f = f x```

The `runIdentity` label is used in the type definition because it follows a style of monad definition that explicitly represents monad values as computations. In this style, a monadic computation is built up using the monadic operators and then the value of the computation is extracted using the `run******` function. Because the Identity monad does not do any computation, its definition is trivial. For a better example of this style of monad, see the State monad.

## 8.4 Example

```-- derive the State monad using the StateT monad transformer
type State s a = StateT s Identity a```

## 9.1 Overview

Computation type:

Computations which may return `Nothing`

Binding strategy:

`Nothing` values bypass the bound function, other values are used as inputs to the bound function.

Useful for:

Building computations from sequences of functions that may return `Nothing`. Complex database queries or dictionary lookups are good examples.

Zero and plus:

`Nothing` is the zero. The plus operation returns the first non-`Nothing` value or `Nothing` is both inputs are `Nothing`.

Example type:

## 9.2 Motivation

The Maybe monad embodies the strategy of combining a chain of computations that may each return `Nothing` by ending the chain early if any step produces `Nothing` as output. It is useful when a computation entails a sequence of steps that depend on one another, and in which some steps may fail to return a value.

Image:Info.png If you ever find yourself writing code like this:

```case ... of
Nothing -> Nothing
Just x  -> case ... of
Nothing -> Nothing
Just y  -> ...```

you should consider using the monadic properties of `Maybe` to improve the code.

## 9.3 Definition

```data Maybe a = Nothing | Just a

return         = Just
fail           = Nothing
Nothing  >>= f = Nothing
(Just x) >>= f = f x

mzero             = Nothing
Nothing `mplus` x = x
x `mplus` _       = x```

## 9.4 Example

A common example is in combining dictionary lookups. Given a dictionary that maps full names to email addresses, another that maps nicknames to email addresses, and a third that maps email addresses to email preferences, you could create a function that finds a person's email preferences based on either a full name or a nickname.

Code available in [[../examples/example11.hs|example11.hs]]

```data MailPref = HTML | Plain
data MailSystem = ...

getMailPrefs :: MailSystem -> String -> Maybe MailPref
getMailPrefs sys name =
do let nameDB = fullNameDB sys
nickDB = nickNameDB sys
prefDB = prefsDB sys
addr <- (lookup name nameDB) `mplus` (lookup name nickDB)

## 10.1 Overview

Computation type:

Computations which may fail or throw exceptions

Binding strategy:

Failure records information about the cause/location of the failure. Failure values bypass the bound function, other values are used as inputs to the bound function.

Useful for:

Building computations from sequences of functions that may fail or using exception handling to structure error handling.

Zero and plus:

Zero is represented by an empty error and the plus operation executes its second argument if the first fails.

Example type:

## 10.2 Motivation

The Error monad (also called the Exception monad) embodies the strategy of combining computations that can throw exceptions by bypassing bound functions from the point an exception is thrown to the point that it is handled.

The `MonadError` class is parameterized over the type of error information and the monad type constructor. It is common to use `Either String` as the monad type constructor for an error monad in which error descriptions take the form of strings. In that case and many other common cases the resulting monad is already defined as an instance of the `MonadError` class. You can also define your own error type and/or use a monad type constructor other than `Either String` or `Either IOError`. In these cases you will have to explicitly define instances of the `Error` and/or `MonadError` classes.

## 10.3 Definition

The definition of the `MonadError` class below uses multi-parameter type classes and funDeps, which are language extensions not found in standard Haskell 98. You don't need to understand them to take advantage of the `MonadError` class.

```class Error a where
noMsg :: a
strMsg :: String -> a

class (Monad m) => MonadError e m | m -> e where
throwError :: e -> m a
catchError :: m a -> (e -> m a) -> m a```

`throwError` is used within a monadic computation to begin exception processing. `catchError` provides a handler function to handle previous errors and return to normal execution. A common idiom is:

`do { action1; action2; action3 } `catchError` handler`

where the `action` functions can call `throwError`. Note that `handler` and the do-block must have the same return type.

The definition of the `Either e` type constructor as an instance of the `MonadError` class is straightforward. Following convention, `Left` is used for error values and `Right` is used for non-error (right) values.

```instance MonadError (Either e) where
throwError = Left
(Left e) `catchError` handler = handler e
a        `catchError` _       = a```

## 10.4 Example

Here is an example that demonstrates the use of a custom `Error` data type with the `ErrorMonad`'s `throwError` and `catchError` exception mechanism. The example attempts to parse hexadecimal numbers and throws an exception if an invalid character is encountered. We use a custom `Error` data type to record the location of the parse error. The exception is caught by a calling function and handled by printing an informative error message.

Code available in [[../examples/example12.hs|example12.hs]]

```-- This is the type of our parse error representation.
data ParseError = Err {location::Int, reason::String}

-- We make it an instance of the Error class
instance Error ParseError where
noMsg    = Err 0 "Parse Error"
strMsg s = Err 0 s

-- For our monad type constructor, we use Either ParseError
-- which represents failure using Left ParseError or a
-- successful result of type a using Right a.