binPow :: Int -> Int -> Int
binPow 0 _ = 1
binPow n a
| even n = let b = binPow (n `div` 2) a in b * b
| otherwise = a * binPow (n - 1) atype IntWithLog = (Int, String)
binPow :: Int -> Int -> IntWithLog
binPow 0 _ = (1, "")
binPow n a
| even n = let (b, msg) = binPow (n `div` 2) a
in (b * b, msg ++ "Square " ++ show b ++ "\n")
| otherwise = let (b, msg) = binPow (n - 1) a
in (a * b, msg ++ "Mul " ++ show a ++ " and " ++ show b ++ "\n")ghci> putStr $ snd $ binPow 3 2
Mul 2 and 1
Square 2
Mul 2 and 4
Lets add some logging to our function
binPow :: Int -> Int -> Writer String Int
binPow 0 _ = return 1
binPow n a
| even n = binPow (n `div` 2) a >>= \b ->
tell ("Square " ++ show b ++ "\n") >>
return (b * b)
| otherwise = binPow (n - 1) a >>= \b ->
tell ("Mul " ++ show a ++ " and " ++ show b ++ "\n") >>
return (a * b)newtype Writer w a = Writer { runWriter :: (a, w) } -- a is value, w is loginstance Monoid w => Monad (Writer w) where
return :: a -> Writer w a
return a = Writer (a, mempty)
(>>=) :: Writer w a -> (a -> Writer w b) -> Writer w b
Writer (a, oldLog) >>= f = let Writer (b, newLog) = f a
in Writer (b, oldLog <> newLog)tell :: w -> Writer w ()
execWriter :: Writer w a -> w
writer :: (a, w) -> Writer w aghci> putStr $ execWriter $ binPow 3 2
...binPow :: Int -> Int -> Writer String Int
binPow 0 _ = return 1
binPow n a
| even n = binPow (n `div` 2) a >>= \b ->
writer (b * b, "Square " ++ show b ++ "\n")
| otherwise = binPow (n - 1) a >>= \b ->
writer (a * b, "Mul " ++ show a ++ " and " ++ show b ++ "\n")1. Decouple logic and logging
binPow (n `div` 2) a >>= \b ->
tell ("Square " ++ show b ++ "\n") >>
return (b * b)2. Concat logs easily
binPow 3 2 >> binPow 3 7Such Writer is described in LYAH and its good for simple explanation. But this type doesn't exist in real world libraries.
Writer is special case of more complex type — WriterT, which means...
1. There's no `Writer` constructor. You can't pattern match on it.
2. There's no `Writer` constructor. Use writer function to create.
Moreover... Things are not too friendly for beginners. There're two libraries where you can find Writer: transformers & mtl.
1. transformers: only types and functions
import Control.Monad.Trans.Writer (Writer, writer, ... )2. mtl: transformers + extra interfaces + shorter imports
import Control.Monad.Writer (Writer, writer, ... )ghci> ([1,2,3], "aba") >> ([5,10], True)
([1,2,3,5,10], True)instance Monoid a => Monad ((,) a) where
(u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b)Basically, Writer is just wrapper around pair. But, please, don't use monad instance for pair. You need to have very good reason for doing this.
Use writer-cps
1. Pure logging
2. Collecting intermediate results
data Environment = Environment { ids :: [Int]
, name :: Int -> String
, near :: Int -> (Int, Int) }What if function wants to access some global variables, some application managers or services, configured at runtime?
It can't. Pass context to function.
inEnv :: Environment -> Int -> Bool
inEnv env i = i `elem` ids envanyInEnv :: Environment -> (Int, Int) -> Bool -- we don't use env directly here :(
anyInEnv env (i, j) = inEnv env i || inEnv env jcheckNeighbours :: Environment -> Int -> Maybe String
checkNeighbours env i = if anyInEnv env (near env i)
then Just (name env i)
else NothingBut passing context to functions every time explicitly becomes tedious very soon... :(
newtype Reader e a = Reader { runReader :: e -> a }ask :: Reader e e -- get whole env
asks :: (e -> a) -> Reader e a -- get part of env
local :: (e -> b) -> Reader b a -> Reader e a -- change env locallyinstance Monad (Reader e) where
return :: a -> Reader e a
return a = Reader $ \_ -> a
(>>=) :: Reader e a -> (a -> Reader e b) -> Reader e b
m >>= f = Reader $ \r -> runReader (f $ runReader m r) rReader is just wrapper around function which takes some e.
Reader monad instance basically just passes (propagates) immutable environment to each function implicitly (automatically).
inEnv :: Int -> Reader Environment Bool
inEnv i = asks (elem i . ids)anyInEnv :: (Int, Int) -> Reader Environment Bool
anyInEnv (i, j) = inEnv i ||^ inEnv jcheckNeighbours :: Int -> Reader Environment (Maybe String)
checkNeighbours i =
asks (`near` i) >>= \pair ->
anyInEnv pair >>= \res ->
if res
then Just <$> asks (`name` i)
else pure Nothingasks :: (e -> a) -> Reader e a -- get part of env
Believe me, this ^ can be written nicer (in two lines)
ghci> runReader (checkNeighbours 0) $ Environment [1] show (const (1,3))
Just "0"
ghci> runReader (checkNeighbours 0) $ Environment [2] show (const (1,3))
NothingIt's not very clear from slides but Reader is the most important monad in real life.
1. You don't need to pass configs and parameters explicitly.
2. You can't accidentally change environment because you don't have direct access to it.
3. Your implementations can be polymorphic and can work with different parts of config.
foo :: a -> b
foo x = __ to the left of = means I don't care about this pattern
_ to the right of = means typed hole
mfold :: [Maybe Bool] -> [Either Bool ()]
mfold = foldr _f _z
join :: Monad m => m (m a) -> m a
join m = _Simple reasoning + types = easy programming
• Found hole: _ :: m aWhat can I do with monad? Only >>= and return. Well, return doesn't help me here obviously, so...
join :: Monad m => m (m a) -> m a
join m = _k >>= _f • Found hole: _k :: m a0
• Found hole: _f :: a0 -> m aWell, m variable obviously is not a function, so...
join :: Monad m => m (m a) -> m a
join m = m >>= _f • Found hole: _f :: m a -> m aHmm... Which function takes x and returns x? Oh, wait, I know!
join :: Monad m => m (m a) -> m a
join m = m >>= id{-# LANGUAGE PartialTypeSignatures #-}
foo :: _ -> Bool
foo x = not xHole.hs:3:8: warning: [-Wpartial-type-signatures]
• Found type wildcard ‘_’ standing for ‘Bool’
• In the type signature: foo :: _ -> Bool
|
3 | foo :: _ -> Bool
| ^arbitCs :: _ => a -> String
arbitCs x = show (succ x) ++ show (x == x)Hole.hs:6:12: warning: [-Wpartial-type-signatures]
• Found type wildcard ‘_’ standing for ‘(Eq a, Enum a, Show a)’
Where: ‘a’ is a rigid type variable bound by
the inferred type of
arbitCs :: (Eq a, Enum a, Show a) => a -> String
at Hole.hs:7:1-42
• In the type signature: arbitCs :: _ => a -> String
|
6 | arbitCs :: _ => a -> String
| ^You can do the same w/o PartialTypeSignatures but compilation fails
Imperative style: change value in variable
Functional style: create new variable with new value
type Stack = [Int]
pop :: Stack -> ?
push :: Int -> Stack -> ?type Stack = [Int]
pop :: Stack -> (Int, Stack)
push :: Int -> Stack -> Stackpop :: Stack -> (Int, Stack)
pop (x:xs) = (x, xs)
push :: Int -> Stack -> Stack
push x s = x:sstackOps :: Stack -> (Int, Stack)
stackOps s = let (x, xs) = pop s
s' = push 5 xs
res = push 10 s'
in (x, res)ghci> stackOps [1,2,3]
(1,[10,5,2,3])newtype State s a = State { runState :: s -> (a, s) }instance Monad (State s) where
return :: a -> State s a
return a = State $ \s -> (a, s)
(>>=) :: State s a -> (a -> State s b) -> State s b
oldState >>= f = ...type State s a = s -> (a, s)Haskell is purely functional: a function, on the same input, always returns the same output. In other words, a pure function cannot store internal state. However, many algorithms are quite naturally expressed in a stateful way, e.g., quicksort; how can we implement them in Haskell? A simple way to represent a stateful computation is as a pure function that takes the initial state as an argument and returns the result together with the final state. The State type describes such functions:
The fact that State s is a monad means that it implements a certain interface (which is the Monad type class in Haskell, but you can translate that in any language with higher-order functions). Without going into the details of it, the consequence is that we can write stateful functions in an imperative style even in a purely functional language.
oldState >>= f = State $ \s -> _
• Found hole ‘_’ with type: (b, s)oldState >>= f = State $ \s -> let (a, newState) = runState oldState s
in _
• Found hole ‘_’ with type: (b, s)(>>=) :: State s a ->
(a -> State s b) ->
State s b
(>>=) :: (s -> (a, s)) ->
(a -> s -> (b, s)) ->
(s -> (b, s))
oldState >>= f = State $ \s -> let (a, newState) = runState oldState s
in _k (f a)
• Found hole ‘_k’ with type: State s b -> (b, s)instance Monad (State s) where
return a = State $ \s -> (a, s)
oldState >>= f = State $ \s -> let (a, newState) = runState oldState s
in runState (f a) newStateoldState >>= f = State $ \s -> let (a, newState) = runState oldState s
in f a
• Couldn't match expected type `(b, s)` with actual type `State s b`type Stack = [Int]
pop :: State Stack Int
pop = state $ \(x:xs) -> (x, xs)
push :: Int -> State Stack ()
push x = ...stackOps :: State Stack Int
stackOps = pop >>= \x -> push 5 >> push 10 >> return xget :: State s s
put :: s -> State s ()
modify :: (s -> s) -> State s ()
gets :: (s -> a) -> State s a
withState :: (s -> s) -> State s a -> State s a
evalState :: State s a -> s -> a
execState :: State s a -> s -> sgchi> evalState stackOps [1, 2, 3]
1
ghci> execState stackOps [1, 2, 3]
[10,5,2,3]type Stack = [Int]
pop :: State Stack Int
pop = state $ \(x:xs) -> (x, xs)
push :: Int -> State Stack ()
push x = state $ \xs -> ((), x:xs)multipop :: Int -> State Stack [Int]
multipop n = ???Repeat N times?
ghci> :t replicateM
replicateM :: Monad m => Int -> m a -> m [a]multipop :: Int -> State Stack [Int]
multipop n = replicateM n popghci> runState (multipop 3) [1..10]
([1,2,3], [4,5,6,7,8,9,10])pop :: State Stack Int
pop = state $ \(x:xs) -> (x, xs)Repeat for each element of a list?
data StackOperation = Pop | Push IntdoOperations :: [StackOperation] -> State Stack ()
doOperations ops = ???ghci> :t forM_
forM_ :: (Monad m, Foldable t) => t a -> (a -> m b) -> m ()doOperations :: [StackOperation] -> State Stack ()
doOperations ops = forM_ ops $ \case -- -XLambdaCase extension
Pop -> pop >> return ()
Push n -> push nghci> execState (doOperations [Pop, Pop, Push 100]) [1..5]
[100,3,4,5]
function add(a, b) {
return a + b;
}add :: Int -> Int -> Int
add x y = x + y
addCPS :: Int -> Int -> (Int -> r) -> r
addCPS x y onDone = onDone (x + y)function addCPS(a, b, callback) {
callback(a + b);
}addCPS(1, 2, function (result) {
// use result here
});onInput :: (String -> IO ()) -> IO () -- every callback framework
onInput action = forever $ getLine >>= actionsquare :: Int -> Int
square x = x * x
pythagoras :: Int -> Int -> Int
pythagoras x y = (+) (square x) (square y)addCPS :: Int -> Int -> ((Int -> r) -> r)
addCPS x y = \k -> k (x + y)
squareCPS :: Int -> ((Int -> r) -> r)
squareCPS x = \k -> k (square x)pythagorasCPS :: Int -> Int -> ((Int -> r) -> r)
pythagorasCPS x y = \k -> -- k :: Int -> r
squareCPS x $ \x2 ->
squareCPS y $ \y2 ->
addCPS x2 y2 $ k -- addCPS x2 y2 :: (Int -> r) -> rghci> pythagorasCPS 3 4 id
25ghci> :t ($)
($) :: (a -> b) -> a -> bgchi> :t ($ 2)
($ 2) :: Num a => (a -> b) -> bghci> map ($ 2) [(3*), (2+),(1-)]
[6,4,-1]newtype Cont r a = Cont { runCont :: (a -> r) -> r }ghci> :t cont
cont :: ((a -> r) -> r) -> Cont r a
gchi> runCont (cont ($ 2)) `map` [(3*), (2+), (1-)]
[6,4,-1]
ghci> runCont (cont ($ 2)) id
2addCPS :: Int -> Int -> Cont r Int
addCPS x y = cont $ \k -> k (x + y)
squareCPS :: Int -> Cont r Int
squareCPS x = cont $ \k -> k (square x)pythagorasCPS :: Int -> Int -> Cont r Int
pythagorasCPS x y = cont $ \k ->
runCont (squareCPS x) $ \x2 ->
runCont (squareCPS y) $ \y2 ->
runCont (addCPS x2 y2) $ kghci> runCont (pythagorasCPS 3 4) id
25newtype Cont r a = Cont { runCont :: (a -> r) -> r }instance Monad (Cont r) where
return :: a -> Cont r a
return a =
(>>=) :: Cont r a -> (a -> Cont r b) -> Cont r b
Cont arr >>= f =instance Monad (Cont r) where
return :: a -> Cont r a
return a = Cont ($ a)
(>>=) :: Cont r a -> (a -> Cont r b) -> Cont r b
Cont arr >>= f = Cont $ \br -> arr $ \a -> runCont (f a) br
-- arr :: (a -> r) -> r
-- br :: (b -> r)
-- f :: a -> Cont r baddCPS :: Int -> Int -> Cont r Int
addCPS x y = return $ x + y
squareCPS :: Int -> Cont r Int
squareCPS = return . squarepythagorasCPS :: Int -> Int -> Cont r Int
pythagorasCPS x y = squareCPS x >>= \x2 ->
squareCPS y >>= \y2 ->
addCPS x2 y2class Monad m => MonadCont m where
callCC :: ((a -> m b) -> m a) -> m a -- call-with-current-continuationinstance MonadCont (Cont r) where
callCC :: ((a -> Cont r b) -> Cont r a) -> Cont r a
callCC f = cont $ \c -> runCont (f (\x -> cont $ \_ -> c x)) cfoo :: Int -> Cont r String
foo x = callCC $ \earlyReturn ->
let y = x ^ 2 + 3 in
when (y > 20) (earlyReturn "over twenty") >>
return $ show (y - 4)callCC gives us back explicit control of continuations
gchi> runCont (foo 2) putStrLn
3
ghci> runCont (foo 10) putStrLn
over twentyimport Control.Monad.Writer (Writer, execWriter, tell)
listTellExample :: Writer [Int] ()
listTellExample = tell [1] >> tell [2] >> tell [3]ghci> execWriter listTellExample
[1,2,3]output :: a -> Writer [a] ()
output a = tell [a]listOutputExample :: Writer [Int] ()
listOutputExample = output 1 >> output 2 >> output 3ghci> execWriter listOutputExample
[1,2,3]