\begin{code}
{-# OPTIONS_GHC -Wall #-}
module Mar01 where
— import qualified Prelude as P
import Prelude hiding (Monad, (>>=), return)
\end{code}
Learning objectives:
\begin{itemize}
\item Monad, Laws
\end{itemize}
——————————————–
Monad.
Roughly: (representation of) computations that sequence
sequence == ordered composition
note: the ‘;’ of C, Java is forward-order composition, aka sequencing
Java’s ‘;’ is basically (flip (.)) in world-passing style
world ~~~ the heap
\begin{code}
class Monad m where
— >>= is pronounced ‘bind’
(>>=) :: m a -> (a -> m b) -> m b
return :: a -> m a
\end{code}
— Back to Modelling computations that can fail…
— simplest case: result is either a value, or nothing, i.e. Maybe
Monads:
– Maybe (potentially failing computation)
– Identity monad (pure values)
– List (kind of represents non-deterministic computations)
– Reader (computations in an environment)
– State (stateful computations), i.e. heap, world-passing, …
… and then it gets weird
– Cont (Continuation monad)
– Tardis
List Monad:
\begin{code}
instance Monad [] where
return a = [a] — sometimes called ‘singleton’
{-
[] >>= _ = []
(x : xs) >>= f = concat (f x : map f xs)
— (f x) ++ (xs >>= f) — alternate, but recursive, defn
-}
l >>= f = concat $ map f l
— Examples
ex1 :: [[Integer]]
ex1 = do x <- [1, 2, 3]
y <- [5, 6, 7]
return [x,y]
\end{code}
- Tree Monad (easiest: tree with data at the leaves only)
Weird ones:
- Backward State
- Tardis -- combines Forward and Backward State, recursively
Weird but important:
- Continuation Monad, on values of type 'a' and return type 'r'
Captures the "future" of a computation
\begin{code}
newtype Cont r a = Cont {runCont :: (a -> r) -> r}
\end{code}
Biggest example: try-catch
Fun exercise: Functor, Monad instance for Cont.
Monad Laws
– laws in term of >>=, even in terms of ‘do’ look ugly, hard to understand.
\begin{code}
(>@>) :: Monad m => (a -> m b) ->
(b -> m c) ->
(a -> m c)
f >@> g = \x -> f x >>= g
\end{code}
Define f =o= g as forall x, f x == g x
Laws:
1. left – unit law
return >@> f =o= f
2. right – unit law
f >@> return =o= f
— it’s like 0 + x = x, or 1 * y = y or “” ++ z = z for the left-unit law
“monoid”
3. associavity law
(f >@> g) >@> h = f >@> (g >@> h)
You implicitly assume that sequencing is associative all the time…