Monads
Here are some simple examples that complement the elegant theory in Martin Oldfield’s monad algebra.
The simplest non-trivial monad is the Maybe monad.
The bind operator for the Maybe monad is like this.
Nothing >>= _ = Nothing
Just x >>= f = f x
Notice how the right-hand side is simply f x. There is no need for another Just, because the type for >>= is like this (which we can see by typing >>= into Hoogle):
(>>=) :: m a -> (a -> m b) -> m b
Specifically, the overall return type of >>= is the same as that of the a -> m b function.
The role of the bind operator is to let the f consume an unboxed argument and emit a boxed argument.
We need a function that can fail:
half :: Int -> Maybe Int
half x = if even x then Just $ x `div` 2 else Nothing
The half function is convenient for chaining because the a and b types are the same.
half 6 ⇒ Just 3
half 7 ⇒ Nothing
half $ half 4 ⇒ Compile error
return 4 >>= half >>= half ⇒ Just 1
half 4 >>= half ⇒ Just 1
half =<< half 4 ⇒ Just 1
Or more pleasingly:
half >=> half $ 4 ⇒ Just 1
The second simplest Monad is the Writer Monad. Let's extend our half function to include some logging.
half :: Int -> WriterT String Maybe Int
half x = do
tell "hello"
lift $ if even x then Just $ x `div` 2 else Nothing
Then we can say this:
runWriterT $ half >=> half $ 4 ⇒ Just (1,"hellohello")
Here it is the other way round. (It took hours to get this to compile! Even now, I am not sure what the return stands for!).
half :: Int -> MaybeT (Writer String) Int
half x = do
lift $ tell "hello"
MaybeT $ return $ if even x then Just $ x `div` 2 else Nothing
This time we get a different answer.
runWriter $ runMaybeT $ half >=> half $ 4 ⇒ (Just 1,"hellohello")
Notice that the answer is upside-down! It looks like a writer of maybes, although the monad transformers define it as a MaybeT of writers.
Here is some simple non-monadic code.
f' :: Int -> Int
f' 0 = 1
f' n = n * f' (n - 1)
And here it is turned into monadic code.
f :: Int -> Writer [String] Int
f 0 = return 1
f n = do
k <- f $ n-1
return $ n * k
The steps were:
Once the code is monadic, we can add calls to tell where we like.
Monadic code can call non-monadic code, e.g. the n * k in this case. We are used to this from the IO monad.
However, unlike in the IO monad, we can have non-monadic code call monadic code. For example:
g :: Int -> Int
g n = fst $ runWriter $ f n
w :: Writer String Int
w = tell "hi" >> return 3
Here’s the same thing:
w :: WriterT String Identity Int
w = WriterT $ Identity (3, "hi")
We can run them like in either of these two ways:
runWriter w
runIdentity $ runWriterT w
To compile them, it seems to be enough to use either of these:
import Control.Monad.Writer
import Control.Monad.Trans.Writer
Here are readers and writers together. Due to some deep magic, all the lifts are optional. However, I have kept the lifts for emphasis.
run_rw = runWriter $ runReaderT rw "foo"
rw :: ReaderT String (Writer String) Int
rw = do
s <- ask
lift $ tell "hi"
lift $ return $ length s
run_wr = runReader (runWriterT wr) "foo"
wr :: WriterT String (Reader String) Int
wr = do
s <- lift $ ask
tell "hi"
lift $ return $ length s
I’m not sure why anyone would want two layers of writers, but here goes anyway.
run_ww = runWriter $ runWriterT ww
ww :: WriterT String (Writer String) Int
ww = do
lift $ tell "lifted"
tell "hi"
lift $ return $ 3
However, it does allow us to see the inside-out nature of monad transformers. From the source code here, we see this:
newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
It shows us that the the writer monad, the “(a, w)”, is inside the guest monad, “m”. We can see from the “readers and writers” section that it is the guest that uses lift. In this writer-writer example, the guest writer is saying “lifted” and the host writer is saying “hi”. Then, because the host monad tucks itself inside, we shouldn’t be surprised to see the “hi” on the inside and the “lifted” on the outside.
*Main> run_ww
((3,"hi"),"lifted")
liftM ≡ fmap
ap ≡ (<*>)
liftM2 ≡ liftA2 ≡ …<$>...<*>...
Here’s a simple parser for reading a number..
import Text.Parsec
import Text.Parsec.String
import Control.Applicative hiding ((<|>))
num :: Parser Int
num = read <$> many1 digit
And here’s a parser that allows numbers to be chained together with minus signs.
t :: Parser Int
t = chainl1 num (char '-' >> return (-))
We can run the parser like this, to get the answer, 4.
parse t "" "8-2-2"
Note how the the minus signs are left-associative. In the original Parsec paper they say that left-associative grammars send combinator parsers into an infinite loop, but, luckily, chainl1 rewrites the grammar. Note how the second argument to chainl1 is higher-order.
{-# LANGUAGE ExistentialQuantification #-}
data Foo = forall a. Show a => Foo a
a :: [Foo]
a = [Foo True, Foo 'q'] -- weird mixture
g :: Foo -> String
g (Foo x) = show x
f :: [String]
f = map g a
foo u v = stuff
where a = b
c = d
let a = b
c = d
in stuff
case expression of pattern -> result
pattern -> result
pattern -> result
case expr of
Left a -> stuff
Right b -> stuff
\x -> x^2
ByteString is for raw sequences of bytes.
Text is for unicode text.
foldM is the monadic equivalent of foldl.
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
sequence :: Monad m => [m a] -> m [a]
f $! x = let !v = x in f v
NF means completely evaluated.
An expression in WHNF has been evaluated to the outermost data constructor or lambda abstraction (the head). E.g. (1+1, 2+2).
import System.IO
type Env = [(String, String)]
main :: IO ()
main = loop [] >> return ()
loop :: Env -> IO Env
loop env = do
str <- putStr ">>> " >> hFlush stdout >> getLine
if (str == "quit")
then return []
else do
let (ans, env') = evalString env str
putStrLn ans
loop env'
evalString :: Env -> String -> (String, Env)
evalString env (c : '=' : str) = ("ok", ([c], str) : env)
evalString env [c] = case lookup [c] env of
Nothing -> ("unknown", env)
Just str -> (str, env)
evalString env _ = ("eh?", env)
import System.IO
import Control.Monad.State
type Env = [(String, String)]
main :: IO ()
main = loop [] >> return ()
loop :: Env -> IO Env
loop env = do
str <- putStr ">>> " >> hFlush stdout >> getLine
if (str == "quit")
then return []
else do
let (ans, env') = runState (evalString str) env
putStrLn ans
loop env'
evalString :: String -> State Env String
evalString (c : '=' : str) = modify (([c], str) :) >> return "ok"
evalString [c] = do
env <- get
case lookup [c] env of
Nothing -> return "unknown"
Just str -> return str
evalString _ = return "eh?"
import System.Console.Haskeline
import System.IO
import Control.Monad.State
import Control.Monad.Identity
type Env = [(String, String)]
main :: IO ()
main = runInputT defaultSettings (runStateT loop []) >> return ()
-- mapStateT :: (m (a, w) -> n (b, w')) -> StateT w m a -> StateT w' n b
-- With our mapper function we need to turn evalString "foo"
-- from StateT Env Identity String
-- to StateT Env (InputT IO) String
-- i.e. in the above, w and w' are Env.
-- m is Identity and n is InputT IO
-- a and b are String.
mapper :: Identity (String, Env) -> (InputT IO) (String, Env)
mapper (Identity (str, env)) = return (str, env)
loop :: StateT Env (InputT IO) ()
loop = do
maybeStr <- lift $ getInputLine ">>> "
case maybeStr of
Nothing -> return ()
Just "quit" -> return ()
Just str -> do
ans <- mapStateT mapper (evalString str)
lift $ outputStrLn ans
loop
evalString :: String -> State Env String
evalString (c : '=' : str) = modify (([c], str) :) >> return "ok"
evalString [c] = do
env <- get
case lookup [c] env of
Nothing -> return "unknown"
Just str -> return str
evalString _ = return "eh?"
av = liftA2 (/) sum length
We can see why this works by analogy with liftA:
liftA sqrt f x = sqrt (f x)
liftA2 op f g x = op (f x) (g x)
More tricks:
join (*)
(sqrt .) . (+)
curry $ sqrt . uncurry (+)
The Mint community suggestion on Haskell Platform didn’t seem to work at all. So I used the generic linux binary instead. Here’s the final report from running sudo /usr/local/haskell/ghc-7.8.3-x86_64/bin/activate-hs
Haskell set to:
GHC /usr/local/haskell/ghc-7.8.3-x86_64
Haddocks file:///usr/local/haskell/ghc-7.8.3-x86_64/doc/frames.html
Other doc file:///usr/local/haskell/ghc-7.8.3-x86_64/share/doc/ghc/html/index.html
Symlinks for command line tools (ghc, cabal, etc..) added to:
/usr/local/bin
When I typed ghci, I got this: libgmp.so: cannot open shared object file: No such file or directory
I typed this: apt install libgmp-dev
Then ghci worked! But cabal failed, until I applied this fix.
http://hackage.haskell.org/package/haskeline-0.7.1.3/docs/System-Console-Haskeline.html
From http://en.wikibooks.org/wiki/Haskell/Laziness:
Nonstrict semantics refers to a given property of Haskell programs that you can rely on: nothing will be evaluated until it is needed.
Lazy evaluation is how you implement nonstrictness using a device called thunks, which we explain in the next section.
A thunk is an unevaluated value with a recipe that explains how to evaluate it.
Performing any degree of evaluation on a value is sometimes called forcing that value.
The only place that Haskell values get evaluated is in pattern matches and inside certain primitive IO functions.
If we have a constructor with strict components (annotated with an exclamation mark, as with data MaybeS a = NothingS | JustS !a), these components become evaluated as soon as we evaluate the level above. I.e. we can never have JustS *thunk* — as soon as we get to this level, the strictness annotation on the component of JustS forces us to evaluate the component part.
For example, the following gives an exception:
let f (JustS _) = 1 in f $ JustS undefined
Functions can be lazy or strict 'in an argument'.
Given two functions of one parameter, f and g, we say f is stricter than g if f x evaluates x to a deeper level than g x.
Often, we only care about WHNF, so a function that evaluates its argument to at least WHNF is called strict and one that performs no evaluation is lazy.
If a function is strict, passing it undefined will result in an error.
When we say "Does f x force x?" what we really mean is "Given that we're forcing f x, does x get forced as a result?".
f ⊥ = ⊥ ⇔ f is strict.
Normally, if you pattern match using a constructor as part of the pattern, you have to evaluate any argument passed into that function to make sure it matches the pattern. For example:
let f (x,y) = 1 in f undefined ⇒ exception
We can make the pattern matching lazy or irrefutable by adding a tilde. For example
let f ~(x,y) = 1 in f undefined ⇒ 1
let f (Just x) = x in f $ Nothing ⇒ non-exhaustive pattern
let f ~(Just x) = x in f $ Nothing ⇒ irrefutable pattern failed
Multiple equations won't work nicely with irrefutable patterns.
Here is a bigger example of monad transformers. It is based on chapter 5 of Stephen Diehl’s Write you a Haskell book.
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Reader
import Data.List
data Expr
= EVar String
| ELam String Expr
| EApp Expr Expr
| EBool Bool | EInt Integer
| EFix Expr
| EAdd Expr Expr | ESub Expr Expr | EMult Expr Expr
| EIf Expr Expr Expr | EZero Expr
deriving (Show)
data Value
= VBool Bool
| VInt Integer
| VClosure String Expr Env deriving Show
ppValue :: Value -> String
ppValue (VBool n) = show n
ppValue (VInt n) = show n
ppValue (VClosure str ex env) = "\\" ++ str ++ " --> " ++ pp ex
type Env = [(String, Thunk)]
ppEnv :: Env -> String
ppEnv env = "[" ++ intercalate ", " (map ppStrTh env) ++ "]"
ppStrTh :: (String, Thunk) -> String
ppStrTh (str, th) = "(" ++ str ++ ", " ++ ppThunk th ++ ")"
ppThunk :: Thunk -> String
ppThunk (ThLeft (ex, env)) = pp ex ++ ", ..."
ppThunk (ThRight v) = ppValue v
data Thunk = ThLeft (Expr, Env) | ThRight Value
deriving Show
lookupEnv :: Env -> String -> Thunk
lookupEnv env n =
maybe (error $ "Unbound Variable " ++ n) id $ lookup n env
isLam :: Expr -> Bool
isLam (ELam _ _) = True
isLam _ = False
eval :: Expr -> StateT Env (WriterT String (Reader String)) Value
eval ex = do
indent <- ask
env <- get
when (not $ isLam ex) $
tell $ indent ++ pp ex ++ " " ++ ppEnv env ++ "\n\n"
local (++ " ") $ eval' ex
eval' :: Expr -> StateT Env (WriterT String (Reader String)) Value
eval' ex = do
indent <- ask
env <- get
case ex of
EVar n -> do
let th = lookupEnv env n
case th of
ThRight v -> return v
ThLeft (ex', env') -> do
let (v, str) = runReader (runWriterT $ evalStateT (eval ex') env') $ indent
tell str
put $ (n, ThRight v) : env
return v
ELam x e -> return $ VClosure x e env
EApp a b -> do
VClosure x e env' <- eval a
let (ans, str) = runReader (runWriterT $
evalStateT (eval e) $ (x, ThLeft (b, env)) : env') $ indent
tell str
return ans
EBool b -> return $ VBool b
EInt n -> return $ VInt n
EFix e -> eval $ EApp e $ EFix e
EAdd a b -> binop (+) a b
ESub a b -> binop (-) a b
EMult a b -> binop (*) a b
EZero a -> do
VInt n <- eval a
return $ VBool $ n == 0
EIf p t f -> do
VBool p' <- eval p
eval $ if p' then t else f
binop :: (Integer -> Integer -> Integer) ->
Expr -> Expr -> StateT Env (WriterT String (Reader String)) Value
binop op a b = do
VInt u <- eval a
VInt v <- eval b
return $ VInt $ u `op` v
pp :: Expr -> String
pp (EVar x) = x
pp (EApp e1 e2) = "(" ++ pp e1 ++ ") (" ++ pp e2 ++ ")"
pp (ELam x e) = "\\" ++ x ++ " -> " ++ pp e
pp (EInt n) = show n
pp (EFix e) = "EFix " ++ pp e
pp (EAdd e1 e2) = pp e1 ++ " + " ++ pp e2
pp (ESub e1 e2) = pp e1 ++ " - " ++ pp e2
pp (EMult e1 e2) = pp e1 ++ " * " ++ pp e2
pp (EZero e) = "EZero " ++ pp e
pp (EIf e1 e2 e3) = "EIf " ++ pp e1 ++ " " ++ pp e2 ++ " " ++ pp e3
pp e = show e
-- Tests
-- -----
-- diverge = fix (\x -> x x)
diverge :: Expr
diverge = EFix (ELam "x" (EApp (EVar "x") (EVar "x")))
-- ignore = \x -> 0
ignore :: Expr
ignore = ELam "x" (EInt 0)
-- omega = (\x -> x x) (\x -> x x)
omega :: Expr
omega = EApp (ELam "x" (EApp (EVar "x") (EVar "x")))
(ELam "x" (EApp (EVar "x") (EVar "x")))
-- t42 = (\y -> 42) omega
t42 = t $ EApp (ELam "y" (EInt 42)) omega
-- t0 = (\y -> 0) diverge
t0 = t $ EApp ignore diverge
--t :: Expr -> (Value, String)
--t ex = runWriter $ evalStateT (eval ex) []
t :: Expr -> IO ()
t ex = do
putStrLn ""
let (ans, str) = runReader (runWriterT $ evalStateT (eval ex) []) ""
putStr str
putStrLn $ "ans = " ++ show ans
putStrLn ""
sq = ELam "q" (EMult (EVar "q") (EVar "q"))
t4 = t $ EApp sq $ EInt 2
t16 = t $ EApp sq $ EApp sq $ EInt 2
t256 = t $ EApp sq $ EApp sq $ EApp sq $ EInt 2
plus1 = ELam "x" $ EAdd (EVar "x") (EInt 1)
one = EInt 1
n = EVar "n"
r = EVar "r"
fact = ELam "r" $ ELam "n" $
EIf (EZero n)
one $
EMult n $ EApp r $ ESub n one
factorial n = EApp (EFix fact) (EInt n)
t0' = t $ factorial 0
t1' = t $ factorial 1
t2 = t $ factorial 2
t6 = t $ factorial 3
t7 = t $ EApp plus1 $ EInt 6
id' = ELam "k" $ EVar "k"
t1 = t $ EApp id' one
t5 = t $ EApp id' $ EAdd (EInt 2) (EInt 3)
dot = ELam "f" $ ELam "g" $ ELam "x" $ EApp (EVar "f") $ EApp (EVar "g") $ EVar "x"
plus2 = EApp (EApp dot plus1) plus1
t3 = t $ EApp plus2 one
This is a few highlights from System.Random.
class RandomGen g where
next :: g -> (Int, g) ……
instance RandomGen StdGen ……
mkStdGen :: Int -> StdGen
getStdGen :: IO StdGen
setStdGen :: StdGen -> IO ()
getStdRandom :: (StdGen -> (a, StdGen)) -> IO a
class Random a where -- instances are Int, Char, Double, …...
random :: RandomGen g => g -> (a, g)
randomR :: RandomGen g => (a, a) -> g -> (a, g)
randomIO :: IO a -- randomIO = getStdRandom random
randomRIO :: (a, a) -> IO a
……
In this example, the rather trivial g function is monad-ready. Thus the j and w functions call g from their respective monads, by passing in their effectful functions. (I hope that is the correct terminology!). For example, w makes the call with this strange looking construct: a <- g return.
import Control.Monad.Writer
g :: (Num a, Monad m) => (a -> m a) -> m a
g f = do
x <- f 2
y <- f $ 2 * x
return y
j :: Maybe Int
j = do
a <- g Just
return a
w :: Writer String Int
w = do
a <- g return
tell "hello"
return a
-- These simple examples demonstrate how some
-- classes expect instances of kind, * -> *.
-- D has kind, * -> * -> *
-- D a has kind, * -> *
-- D a b has kind, *
data D a b = D a b
-- This class expects instances of kind, *.
class C a where
f :: a -> Int
instance C Char where
f _ = 3
instance C (Maybe a) where
f _ = 4
instance C (D a b) where
f _ = 5
-- This class expects instances of kind, * -> *,
-- because the 'm' in 'ret' has a parameter.
class Mo m where
ret :: a -> m a
instance Mo Maybe where
ret x = Just x
instance Mo (D a) where
ret = undefined
In the transformers package in the Control.Monad.Trans.Maybe module, there is this bit of madness:
instance (Monad m) => Monad (MaybeT m) where
return = lift . return
It seems crazy that the same function, “return”, can appear on the left and the right of the equation. The answer is that “return” is a class member and therefore the “return”s on the left and the right are different functions.
Here is the definition again, but with comments.
instance (Monad m) => Monad (MaybeT m) where
return = -- a -> MaybeT m a
lift . -- m a -> MaybeT m a
return -- a -> m a
And here is everything spelt out:
instance Monad m => Monad (MaybeT m) where
return = ret_MaybeT
ret_MaybeT :: Monad m => a -> MaybeT m a
ret_MaybeT = let
lif = lift :: Monad m => m a -> MaybeT m a
ret = return :: Monad m => a -> m a
in lif . ret
These are minimal examples based on the excellent 24 Days of GHC Extensions.
{-# LANGUAGE ViewPatterns #-}
f :: Int -> String
f (odd -> True) = "odd"
f _ = "even"
{-# LANGUAGE PatternSynonyms #-}
pattern One = 1
f :: Int -> String
f One = "One"
f _ = "unknown"
k = One
{-# LANGUAGE RecordWildCards #-}
data Pt = Pt {x :: Int, y :: Int} deriving Show
f :: Pt -> Int
f Pt{..} = x + y
k :: Maybe Pt
k = do
x <- Just 3
y <- Just 4
return Pt{..}
{-# LANGUAGE BangPatterns #-}
import Data.List
mean :: [Double] -> Double
mean xs = s / fromIntegral l
where
(s, l) = foldl' step (0, 0) xs
step (!s, !l) a = (s + a, l + 1)
{-# LANGUAGE RebindableSyntax #-}
import Prelude
a = do
2
2
where (>>) = (+)
return = id
h = "a" + "b" where (+) = (++)
k = map 3 where map = odd
c2f = do
(*9)
(/5)
(+32)
where (>>) = flip (.)
return = id
{-# LANGUAGE ParallelListComp #-}
a = [ x+y | x <- [1,2] , y <- [1,2] ]
b = [ x+y | x <- [1,2] | y <- [1,2] ]
then… group… by… using...
Allows list comprehension syntax for arbitrary monads.
{-# LANGUAGE TypeOperators #-}
type CC = Char + Char
data a + b = Plus a b deriving Show
f :: Int + Int -> Int + Int
f (Plus a b) = Plus b a
{-# LANGUAGE RecursiveDo #-}
j1 = do
rec x <- Just x
return 3
j2 = mdo
y <- Just x
x <- Just 3
return y
{-# LANGUAGE NullaryTypeClasses #-}
class C where
k :: Int
instance C where
k = 3
{-# LANGUAGE ImplicitParams #-}
f :: (?foo :: Int) => Int
f = ?foo * ?foo
m :: Int
m = let ?foo = 3 in f
-- This is a huge topic! I struggled to get anything to compile.
{-# LANGUAGE TypeFamilies #-}
import Data.IntSet as S
class GSetKey k where
data GSet k :: *
member :: k -> GSet k -> Bool
instance GSetKey Int where
data GSet Int = GSet (S.IntSet)
member k (GSet s) = S.member k s
-- Another big topic, I think.
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
class Collection c a where
f :: c a -> a
data L a = L [a]
data L2 a = L2 [[a]]
instance Collection L a where
f (L [v]) = v
instance Collection L2 a where
f (L2 [[v]]) = v
instance Collection [] Int where
f [v] = 42 -- silly
instance Collection Maybe a where
f (Just v) = v
-- Functional Dependencies allow us to add the text shown in red.
-- Apparently, it helps with type inferencing.
-- Unfortunately, it broke nearly all the examples in the section above.
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
class Collection c a | c -> a where
f :: c a -> a
data L a = L [a]
instance Collection L Int where
f (L [v]) = v
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Traversable
import Data.Foldable
import Data.Data
import Data.Typeable
data List a = Nil | Cons a (List a)
deriving (Eq, Show, Functor, Foldable, Traversable)
-- traverse is a generalisation of mapM to more than just lists
-- and to applicatives rather than monads.
-- mapM :: Monad m => (a -> m b) -> [a] -> m [b]
-- traverse :: (Traversable t, Applicative f) =>
-- (a -> f b) -> t a -> f (t b)
-- There is also a mapM in Data.Traversable.
-- Data.Traversable.mapM
-- :: (Traversable t, Monad m) =>
-- (a -> m b) -> t a -> m (t b)
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Applicative
newtype M a = M (Maybe a) deriving
(Show, Functor, Applicative, Monad)
I am going to come back to this one later.
…………..
allows us to write class constraints such as (Stream s u Char) =>, where one of the type variables is defined instead of polymorphic.
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
k :: T.Text
k = "hi"
{-# LANGUAGE FlexibleInstances #-}
-- I can't find the official documentation for
-- this extension.
-- However, I found this SO quote here:
-- FlexibleInstances is one of the most harmless
-- language extensions that exist. Just enable it.
class C a where
f :: a -> Int
instance C (Maybe Char) where
f _ = 4