575 lines
19 KiB
Haskell
575 lines
19 KiB
Haskell
{- monads.hs
|
|
|
|
This file contains the examples on monads to be shown in the third
|
|
class of the course "Haskell for Life", by Sergiu Ivanov
|
|
(sivanov@lacl.fr):
|
|
|
|
http://lacl.fr/~sivanov/doku.php?id=en:haskell_for_life
|
|
|
|
This file is meant to be read sequentially.
|
|
|
|
This file is distributed under the Creative Commons Attribution Alone
|
|
licence.-}
|
|
|
|
-- This line imports the (<>) operator from the module 'Data,Monoid'
|
|
-- (we will need faaar below for the MyWriter monad).
|
|
import Data.Monoid((<>))
|
|
|
|
-- | We will cheat and use these meaningless type synonyms.
|
|
type Person = String
|
|
type Car = String
|
|
|
|
personByName :: String -> Maybe Person
|
|
personByName p = Just p
|
|
|
|
carByPerson :: Person -> Maybe Car
|
|
carByPerson p = Just (p ++ "'s car")
|
|
|
|
model :: Car -> Maybe String
|
|
model c = Just ("model of " ++ c)
|
|
|
|
modelFromName :: String -> Maybe String
|
|
modelFromName name = do
|
|
person <- personByName name
|
|
car <- carByPerson person
|
|
model car
|
|
|
|
|
|
|
|
{- In this section we will reconstruct the Maybe monad.-}
|
|
|
|
data Perhaps a = Only a | Nope
|
|
deriving Show
|
|
|
|
instance Monad Perhaps where
|
|
-- | return :: a -> Perhaps a
|
|
--
|
|
-- This implementation is quite natural: we just put the value we
|
|
-- get inside an instance of 'Perhaps', and we cannot actually
|
|
-- implement it differently. Indeed, since we don't know anything
|
|
-- about the type 'a', we cannot construct values of that type, nor
|
|
-- can we transform them.
|
|
--
|
|
-- ATTENTION! 'return' does not abort execution of any block of code
|
|
-- (as in some other languages)! It's just a function called
|
|
-- "return".
|
|
return x = Only x
|
|
|
|
-- | (>>=) :: Perhaps a -> (a -> Perhaps b) -> Perhaps b
|
|
Nope >>= f = Nope
|
|
(Only x) >>= f = f x
|
|
|
|
-- | If you try to compile the file now, GHC will complain that there
|
|
-- is no instance for 'Applicative Perhaps'; that instance is required
|
|
-- by the definition of 'Monad'. Let's try defining one, just looking
|
|
-- at the types of the functions.
|
|
instance Applicative Perhaps where
|
|
-- | pure :: a -> Perhaps
|
|
--
|
|
-- Wait a second, that's the type of return!
|
|
pure = return
|
|
|
|
-- | (<*>) :: Perhaps (a -> b) -> Perhaps a -> Perhaps b
|
|
--
|
|
-- OK, so we have a function (perhaps), and we need to apply to
|
|
-- (perhaps) a value and then return the result (perhaps). Let's do
|
|
-- that.
|
|
--
|
|
-- Note that we don't use the fact that we work with Perhaps, since
|
|
-- only the definitions coming from our instance of 'Monad' are
|
|
-- enough. This means that we will be able to copy this definition
|
|
-- as-is for the other monads we will construct.
|
|
u <*> v = do -- This means we do our stuff within a monad.
|
|
f <- u -- Extract the function.
|
|
x <- v -- Extract the value.
|
|
return (f x) -- Feed the value to the function and pack the
|
|
-- result.
|
|
|
|
-- | Oh noes, we still cannot compile this code: no instance for
|
|
-- 'Functor Perhaps'. Well, 'Functor' seems easy enough.
|
|
instance Functor Perhaps where
|
|
-- | fmap :: (a -> b) -> Perhaps a -> Perhaps
|
|
--
|
|
-- Hey, that's simple enough!
|
|
--
|
|
-- fmap f Nope = Nope
|
|
-- fmap f (Only x) = Only (f x)
|
|
--
|
|
-- This code is specific to 'Perhaps', however. We could perhaps
|
|
-- (pun intended) re-use our definition of 'Monad' once again:
|
|
--
|
|
-- fmap f v = do
|
|
-- x <- v -- Unpack 'v'.
|
|
-- return (f x) -- Feed 'x' to f and pack back the result.
|
|
--
|
|
-- Yet, we will use the following cool definition based on the
|
|
-- definition from the instance of 'Applicative'. It's more compact
|
|
-- and is nice and simple exercise in Haskell types.
|
|
fmap f x = pure f <*> x
|
|
|
|
-- Let's check now that our 'Perhaps' is similar to 'Maybe', as we
|
|
-- wanted.
|
|
personByName' :: String -> Perhaps Person
|
|
personByName' p = Only p
|
|
|
|
carByPerson' :: Person -> Perhaps Car
|
|
carByPerson' p = Only (p ++ "'s car")
|
|
|
|
model' :: Car -> Perhaps String
|
|
model' c = Only ("model of " ++ c)
|
|
|
|
modelFromName' :: String -> Perhaps String
|
|
modelFromName' name = do
|
|
person <- personByName' name
|
|
car <- carByPerson' person
|
|
model' car
|
|
|
|
|
|
|
|
{- In this section we will reconstruct the list monad.-}
|
|
|
|
data List a = Cons a (List a) | Nil
|
|
deriving Show
|
|
|
|
-- | Concatenates two 'List's.
|
|
concat2 :: List a -> List a -> List a
|
|
concat2 Nil ys = ys
|
|
concat2 (Cons x xs) ys = Cons x (concat2 xs ys)
|
|
|
|
-- | Concatenates a 'List' of 'Lists'.
|
|
--
|
|
-- Example:
|
|
-- concatLists ( Cons (Cons 1 Nil) (Cons (Cons 2 Nil) Nil) ) == Cons 1 (Cons 2 Nil)
|
|
concatLists :: List (List a) -> List a
|
|
concatLists xs = concatAll xs Nil
|
|
where concatAll (Cons x xs) res = concatAll xs (concat2 res x)
|
|
concatAll Nil res = res
|
|
|
|
-- | Applies the function to all elements of the list and returns the
|
|
-- list of results.
|
|
mapList :: (a -> b) -> List a -> List b
|
|
mapList _ Nil = Nil
|
|
mapList f (Cons x xs) = Cons (f x) (mapList f xs)
|
|
|
|
instance Monad List where
|
|
-- | return :: a -> List a
|
|
--
|
|
-- Create a singleton list out of 'x', just like in the case of
|
|
-- 'Maybe'.
|
|
return x = Cons x Nil
|
|
|
|
-- (>>=) :: List a -> (a -> List b) -> List b
|
|
--
|
|
-- So, we should probably feed the values from 'List a' into the
|
|
-- function 'a -> List b' one by one (we don't really have any other
|
|
-- choice). Then we are going to get a bunch of 'List b'; we should
|
|
-- probably concatenate them to get one single big 'List b'.
|
|
x >>= f = concatLists (mapList f x)
|
|
|
|
-- | And for our 'Applicative' and 'Functor' instances we'll just
|
|
-- reuse the code we wrote for 'Perhaps'.
|
|
instance Applicative List where
|
|
pure = return
|
|
u <*> v = do
|
|
f <- u
|
|
x <- v
|
|
return (f x)
|
|
|
|
instance Functor List where
|
|
fmap f x = pure f <*> x
|
|
|
|
-- | Now let's see what kind of tricks one can do in the list monad.
|
|
-- We will use Haskell's built-in '[]' for convenience, but exactly
|
|
-- the same things can be done in `List'.
|
|
|
|
-- | Compute the Cartesian product of two lists.
|
|
--
|
|
-- We "unpack" first 'xs', then 'ys', and put the obtained 'x' and 'y'
|
|
-- together. Note that the bind operator '(>>=)' in the list monad
|
|
-- means that the lambda functions are applied to every element in
|
|
-- 'xs' and 'ys'. In other words, '(>>=)' is a kind of a foreach
|
|
-- loop.
|
|
cartesian :: [a] -> [b] -> [(a,b)]
|
|
cartesian xs ys = xs >>=
|
|
(\x -> ys >>=
|
|
(\y -> return (x,y)))
|
|
|
|
-- | Now, let's rewrite the same function using the do notation. In
|
|
-- this case, every "unpacking" (<-) means a loop over all elements of
|
|
-- the list. Thus, we loop over all elements of 'xs'; then, for each
|
|
-- such element, we loop over 'ys' and produce a pair '(x,y)' at each
|
|
-- iteration.
|
|
cartesian' :: [a] -> [b] -> [(a,b)]
|
|
cartesian' xs ys = do
|
|
x <- xs
|
|
y <- ys
|
|
return (x,y)
|
|
|
|
|
|
-- | Return a list of elements for which the given function returns
|
|
-- 'True'.
|
|
--
|
|
-- Note that we do not use return; instead we produce the singleton
|
|
-- list '[x]' directly. We need that to be able to write '[]' when
|
|
-- 'x' does satisfy the property.
|
|
myFilter :: (a -> Bool) -> [a] -> [a]
|
|
myFilter f xs = do
|
|
x <- xs
|
|
if f x then [x] else []
|
|
|
|
|
|
|
|
{- In this section we will reconstruct a simplified version of the
|
|
State monad.-}
|
|
|
|
-- | Our simplified state monad.
|
|
data MyState s a = MyState (s -> (a, s))
|
|
|
|
-- | This is just a getter for the only field of 'MyState'.
|
|
runState :: MyState s a -> (s -> (a, s))
|
|
runState (MyState f) s = f s
|
|
|
|
{- In the case of the 'Maybe' ('Perhaps') monad, we wanted to deal
|
|
with functions returning 'Maybe a'. In the case of state, we want to
|
|
deal with functions which get state as an argument and which return
|
|
their result _and also_ the new state. Thus, the functions we work
|
|
with have types of the form
|
|
|
|
'arg1 -> ... -> argn -> state -> (result, state)'.
|
|
|
|
Since the bind operator (>>=) will have to pass the state from one
|
|
function to another one, we cannot just define
|
|
|
|
data MyState s a = MyState (a, s)
|
|
|
|
If we did that, the bind operator (>>=) would have no way of passing
|
|
the state to the next function. With our definition of 'MyState' as
|
|
containing a field of a function type, we will be able to pass around
|
|
the state.
|
|
|
|
The next issue is that 'Monad' can only work with types having one
|
|
parameter, while 'MyState' has two. This means that we will have to
|
|
fix one of them. If we fix the parameter 'a' (which is the result of
|
|
computation), then bind (>>=) should be able to put together two
|
|
functions returning the same result, but using states of different
|
|
type, which is not what we want. Therefore, we are going to fix 's',
|
|
the type of the state.-}
|
|
|
|
instance Monad (MyState s) where
|
|
-- | return :: a -> MyState s a
|
|
-- return :: a -> (s -> (a, s))
|
|
--
|
|
-- We don't want 'return' to tinker with the state; it should just
|
|
-- put our value into the monad, nothing more. So, it will return a
|
|
-- function taking the state and returning a tuple containing 'x'
|
|
-- and _the same_ state.
|
|
return x = MyState (\s -> (x, s))
|
|
|
|
-- | (>>=) :: MyState s a -> (a -> MyState s b) -> MyState s b
|
|
--
|
|
-- Now, that's a more difficult type. Without going too much into
|
|
-- details, let's keep in mind that we want to get the result out of
|
|
-- 'MyState s a' and put it into the function which is the second
|
|
-- argument. Now, how do we get the result ('a') out of 'MyState s
|
|
-- a'? 'MyState s a' is the same thing as 's -> (a,s)', so we could
|
|
-- get an 'a' if we had an 's', which we don't seem to have...
|
|
--
|
|
-- But wait a little! We are supposed to return 'MyState s b',
|
|
-- which is actually 's -> (b,s)'; that is, we are supposed to
|
|
-- return a function! And inside this function, we can haz access
|
|
-- to an instance of 's' which we can use to run the first argument
|
|
-- ('MyState s a') and get our instance of 'a' to feed into the
|
|
-- second argument.
|
|
--
|
|
-- And yes, a let declaration is just a local binding of values,
|
|
-- like:
|
|
--
|
|
-- let x = 2
|
|
-- y = 3
|
|
-- in x + y
|
|
--
|
|
-- We can also use pattern matching in let bindings (just like in
|
|
-- GHCi).
|
|
x >>= f = MyState (\s ->
|
|
-- Run 'x' and get the tuple (result,state) in runState (f a) s'
|
|
let (a,s') = runState x s
|
|
-- Apply 'f' to 'a', and then run the resulting
|
|
-- state with 's'.
|
|
in runState (f a) s')
|
|
|
|
-- | Again, a small copy-and-paste work to get our 'Applicative' and
|
|
-- 'Functor' instances in place.
|
|
instance Applicative (MyState s) where
|
|
pure = return
|
|
u <*> v = do
|
|
f <- u
|
|
x <- v
|
|
return (f x)
|
|
|
|
instance Functor (MyState s) where
|
|
fmap f x = pure f <*> x
|
|
|
|
-- | Oh, before we get to write any functions using our 'MyState'
|
|
-- monad, we have to provide a way to access our state.
|
|
|
|
-- | Returns the current state.
|
|
--
|
|
-- Remember that unpacking (<-) in a State monad means getting the
|
|
-- first element of the tuple returned by any function in this monad.
|
|
-- Thus, the only thing 'myGet' needs to do is put the state it gets
|
|
-- as an argument into the first component of the tuple.
|
|
myGet :: MyState s s
|
|
myGet = MyState (\s -> (s, s))
|
|
|
|
-- | Sets the current state.
|
|
--
|
|
-- 'myPut' only changes the state and does not return anything
|
|
-- meaningful; we therefore make it put the empty tuple '()' (unit)
|
|
-- into the first component of the returned tuple, and we put the new
|
|
-- state into the second component of the returned tuple.
|
|
myPut :: s -> MyState s ()
|
|
myPut s' = MyState (\_ -> ((), s'))
|
|
|
|
{- We can now use MyState to implement a small database of cars and
|
|
people.-}
|
|
data CarsPeopleDB = CarsPeopleDB [Car] [Person]
|
|
deriving Show
|
|
|
|
cars :: CarsPeopleDB -> [Car]
|
|
cars (CarsPeopleDB c _) = c
|
|
|
|
people :: CarsPeopleDB -> [Person]
|
|
people (CarsPeopleDB _ p) = p
|
|
|
|
-- | This function adds a car to the database.
|
|
--
|
|
-- This function can access the database because it is in the
|
|
-- 'MyState' monad (it returns the type 'MyState <bla bla>'). It just
|
|
-- adds a car and returns nothing, that's why the '()'.
|
|
addCar :: Car -> MyState CarsPeopleDB ()
|
|
addCar c = do
|
|
db <- myGet -- Get the database.
|
|
|
|
let cs = cars db -- Get the list of cars.
|
|
ps = people db -- Get the list of people.
|
|
|
|
let db' = (CarsPeopleDB (c:cs) ps) -- Build the new database.
|
|
|
|
myPut db' -- Save the new database.
|
|
|
|
-- | Adds a person to the database.
|
|
--
|
|
-- Does the same thing as 'addCar', but is written more concisely.
|
|
addPerson :: Person -> MyState CarsPeopleDB ()
|
|
addPerson p = do
|
|
(CarsPeopleDB cs ps) <- myGet
|
|
myPut (CarsPeopleDB cs (p:ps))
|
|
|
|
-- | Checks whether a car is in the database.
|
|
--
|
|
-- Now, besides producing the new state, this function should also
|
|
-- tell us whether the car is in the database or not. That is why the
|
|
-- second argument to 'MyState' is 'Bool' — it's the answer of the
|
|
-- function.
|
|
carKnown :: Car -> MyState CarsPeopleDB Bool
|
|
carKnown c = do
|
|
(CarsPeopleDB cs _) <- myGet
|
|
return (elem c cs) -- Pack the result of checking whether 'c' is an
|
|
-- element of 'cs'.
|
|
|
|
-- | Checks whether a person is in the database.
|
|
personKnown :: Person -> MyState CarsPeopleDB Bool
|
|
personKnown p = do
|
|
(CarsPeopleDB _ ps) <- myGet
|
|
return (elem p ps)
|
|
|
|
|
|
-- | And now we can use our functions to build a real (c) (hehe)
|
|
-- database of car and people!
|
|
testCarsPeopleDB :: CarsPeopleDB
|
|
testCarsPeopleDB = let (res, db) = runState buildDB (CarsPeopleDB [] [])
|
|
in db
|
|
where buildDB = do
|
|
addPerson "John"
|
|
addPerson "Mary"
|
|
addCar "Mercedes"
|
|
addCar "Renault"
|
|
|
|
johnKnown <- personKnown "John"
|
|
if not johnKnown
|
|
then addPerson "Bruce"
|
|
else return () -- We have to do something in the else
|
|
-- branch as well, so let's just pack an
|
|
-- empty tuple.
|
|
|
|
|
|
|
|
{- In this section we will define a simplified version of the Reader
|
|
monad.-}
|
|
|
|
-- | The Reader monad is essentially the read-only State monad. Since
|
|
-- the state never changes, we do not need to deal with functions of
|
|
-- the form 's -> (a,s)', but only 's -> a' (there is no new state, it
|
|
-- is always the same).
|
|
--
|
|
-- We will use the so-called "record syntax" to define the accessor
|
|
-- for the single field of MyReader. It is really a syntactic sugar
|
|
-- for
|
|
--
|
|
-- data MyReader s a = MyReader (s -> a)
|
|
-- runReader :: MyReader s a -> (s -> a)
|
|
-- runReader (MyReader f) = f
|
|
data MyReader s a = MyReader { runReader :: s -> a
|
|
}
|
|
|
|
-- | The 'Monad' instance for 'MyReader' is defined in _exactly_ the
|
|
-- same way as for 'MyState'.
|
|
instance Monad (MyReader s) where
|
|
return x = MyReader (\s -> x)
|
|
|
|
-- | This time we don't have to deal with the new state, so things
|
|
-- are simpler. We first run 'x' with the state 's'; it returns an
|
|
-- instance of 'a'. Then we feed this result to 'f', and then run
|
|
-- the resulting reader with the same state 's'.
|
|
x >>= f = MyReader (\s -> runReader (f (runReader x s)) s )
|
|
|
|
-- | Again, some copy and paste.
|
|
instance Applicative (MyReader s) where
|
|
pure = return
|
|
u <*> v = do
|
|
f <- u
|
|
x <- v
|
|
return (f x)
|
|
|
|
instance Functor (MyReader s) where
|
|
fmap f x = pure f <*> x
|
|
|
|
-- | And a small function to tell us our read-only state. (It's
|
|
-- exactly like 'myGet', but is called differently).
|
|
myAsk :: MyReader s s
|
|
myAsk = MyReader (\s -> s)
|
|
-- myAsk = MyReader id
|
|
|
|
{- And here's a very simple and stupid example. We will write
|
|
functions generating various greetings for a name, which will be
|
|
obtained from the reader monad-}
|
|
|
|
hello :: MyReader Person String
|
|
hello = do
|
|
name <- myAsk
|
|
return $ "Hello " ++ name ++ "!" -- The $ is just a shortcut for not
|
|
-- writing parentheses.
|
|
-- return ("Hello " ++ name ++ "!")
|
|
|
|
howdy :: MyReader Person String
|
|
howdy = do
|
|
name <- myAsk
|
|
return $ "Howdy " ++ name ++ "!"
|
|
|
|
goodMorning :: MyReader Person String
|
|
goodMorning = do
|
|
name <- myAsk
|
|
return $ "Good morning " ++ name ++ "!"
|
|
|
|
-- This function produces all possible (hehe) greetings for the given
|
|
-- name.
|
|
--
|
|
-- Mind the pointfree style! The function may actually be written as
|
|
--
|
|
-- greetings name = runReader mkGreetings name
|
|
--
|
|
greetings :: String -> [String]
|
|
greetings = runReader mkGreetings
|
|
where mkGreetings = do
|
|
hl <- hello
|
|
hw <- howdy
|
|
gm <- goodMorning
|
|
return [hl,hw,gm]
|
|
|
|
|
|
|
|
{- In this section we will define a simplified version of the Writer
|
|
monad.-}
|
|
|
|
-- | The Writer monad is essentially a write-only State monad. Since
|
|
-- the functions in this monad do not need to access the state, the
|
|
-- type of the Writer monad is really really simple: just a tuple.
|
|
--
|
|
-- (Mind the record syntax.)
|
|
data MyWriter s a = MyWriter { runWriter :: (a,s) }
|
|
|
|
-- | There's a catch however: we're not really interested in a
|
|
-- write-only state: this would mean that we always get the state set
|
|
-- by the last function. That is why in the Writer monad the state is
|
|
-- actually an accumulator and, instead of changing it directly, the
|
|
-- functions in this monad append stuff to it. Therefore, the Writer
|
|
-- monad is the logger monad.
|
|
--
|
|
-- What we have just said means that we require some special
|
|
-- properties of 's' (some special structure): we should be able to
|
|
-- put together (append, concatenate) to values of type 's', like
|
|
-- lists or with strings. This property is described by the typeclass
|
|
-- 'Monoid'; types belonging to this typeclass have the function
|
|
-- 'mappend' (or '<>', which is the same thing) which can append two
|
|
-- values, and also the function 'mempty', returning the "empty"
|
|
-- element (like the empty list or the empty string).
|
|
instance (Monoid s) => Monad (MyWriter s) where
|
|
-- | This where the 'mempty' function for the type 's' comes in handy:
|
|
-- return "packs" the value "x" together with an empty log.
|
|
return x = MyWriter (x,mempty)
|
|
|
|
-- | We have to take the result out of 'x' and feed it into 'f', and
|
|
-- then put together the logs of the two.
|
|
x >>= f = let (r, w ) = runWriter $ x
|
|
(r',w') = runWriter $ f r
|
|
in MyWriter (r', w <> w')
|
|
|
|
-- | Some more instances...
|
|
instance (Monoid s) => Applicative (MyWriter s) where
|
|
pure = return
|
|
u <*> v = do
|
|
f <- u
|
|
x <- v
|
|
return $ f x
|
|
|
|
instance (Monoid s) => Functor (MyWriter s) where
|
|
fmap f x = pure f <*> x
|
|
|
|
-- | ... and a small function appending something to the log.
|
|
myTell :: Monoid s => s -> MyWriter s ()
|
|
myTell x = MyWriter ((), x)
|
|
|
|
{- And now it's time for an eccentric example! Let's make a weirdly
|
|
verbose calculator.-}
|
|
|
|
-- | The following functions carry out some operations, but also log
|
|
-- what they do to the Writer monad.
|
|
myAdd :: Double -> Double -> MyWriter [String] Double
|
|
myAdd x y = do
|
|
myTell $ [show x ++ "+" ++ show y]
|
|
return $ x + y
|
|
|
|
mySub :: Double -> Double -> MyWriter [String] Double
|
|
mySub x y = do
|
|
myTell $ [show x ++ "-" ++ show y]
|
|
return $ x - y
|
|
|
|
myMul :: Double -> Double -> MyWriter [String] Double
|
|
myMul x y = do
|
|
myTell $ [show x ++ "*" ++ show y]
|
|
return $ x * y
|
|
|
|
myDiv :: Double -> Double -> MyWriter [String] Double
|
|
myDiv x y = do
|
|
myTell $ [show x ++ "/" ++ show y]
|
|
return $ x / y
|
|
|
|
-- | Let's test our calculator.
|
|
testCalc :: (Double, [String])
|
|
testCalc = runWriter $ do
|
|
let x = 2
|
|
y <- myMul x 2
|
|
z <- mySub y 3
|
|
t <- myDiv y 10
|
|
a <- myAdd z t
|
|
return a
|