\begin{code}
{-# OPTIONS_GHC -Wall #-}
module Feb25 where
— import qualified Prelude as P
import Prelude hiding (Functor, Monad, (>>=), return)
\end{code}
Learning objectives:
\begin{itemize}
\item Functor, laws
\item Monad, Laws
\end{itemize}
\begin{code}
class Functor f where
fmap :: (a -> b) -> f a -> f b
\end{code}
\begin{code}
instance Functor [] where
fmap f l = map f l
instance Functor Maybe where
fmap _ Nothing = Nothing — fmap.Maybe.1
fmap f (Just a) = Just (f a) — fmap.Maybe.2
\end{code}
Laws:
1. forall x. fmap id x = id x
2. forall x, f, g. fmap f (fmap g x) = fmap (f . g) x
Prove, Functor for Maybe satisfies the laws:
1. first law, two cases:
fmap id Nothing == — fmap.Maybe.1
Nothing == — id.1
id Nothing
fmap id (Just x) == — fmap.Maybe.2
Just (f x) == — id.1
id (Just (f x))
2. second law
fmap f (fmap g Nothing) == — fmap.Maybe.1
fmap f Nothing == — fmap.Maybe.1
Nothing == — fmap.Maybe.1
fmap (f . g) Nothing
fmap f (fmap g (Just x)) == — fmap.Maybe.2
fmap f (Just (g x)) == — fmap.Maybe.2
Just (f (g x)) == — (.) defn
Just ((f . g) x) == — fmap.Maybe.2
fmap (f . g) (Just x)
— 6 minutes?
Reader: “Values that dependent on an environment”
\begin{code}
newtype Reader e a = Reader (e -> a)
instance Functor (Reader e) where
— f :: a -> b
— r :: e -> a
fmap f (Reader r) = Reader $ \e -> f (r e)
— if you want to go point-free:
— fmap f (Reader r) = Reader (f . r)
— reader Functors works by post-composition
\end{code}
——————————————–
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
\begin{code}
instance Monad Maybe where
— m :: Maybe a
— f :: (a -> Maybe b)
Nothing >>= _ = Nothing
(Just x) >>= f = f x
return x = Just x
\end{code}
Want to do examples… but they look ugly:
\begin{code}
z :: Maybe Integer
z =
Just 5 >>= (\x -> return $ x + 2)
>>= (\x -> return $ x * 7)
\end{code}
Sugar time!
do x <- m -- bind an x to the result of computation m
f x -- continue computation with f
is the same as
m >>= f
\begin{code}
z’ :: Maybe Integer
z’ = do x <- Just 5
y <- return $ x + 2
w <- return $ y * 7
return w
\end{code}
\begin{code}
w' :: Maybe Integer
w' = do x <- Just 5 -- experiment : change to Nothing
y <- Just 3 -- experiment : change to Nothing
return $ x + y
\end{code}
enables writing:
w'' n = do
x <- f n
y <- g x
t <- h y
return (t*(x+y))
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