This was very helpful. So ← only works with types that take a single argument? How does one work with other types in do?
It is important here to make a clear distinction between terms and types. In your example:
data IntList = Nil | List {val :: Int, next :: IntList} deriving Show
The type is IntList
and it has terms Nil :: IntList
and List :: Int -> IntList -> IntList
. You see that IntList
is a type without any arguments, Nil
is a term without arguments and List
is a term with two arguments.
The main requirement to using a type with <-
is that it needs to be a Monad
*:
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
This means that you must be able to define two functions: return
and (>>=)
with those types. For a concrete type like IntList
you can just fill in IntList
at every place where there is a m
variable in the type signatures of those two functions. That yields: return :: a -> IntList a
and (>>=) :: IntList a -> (a -> IntList b) -> IntList b
. Here you can see the problem. IntList
is a type without any arguments, so writing IntList a
does not make any sense. To be able to use a type in do notation it needs to have at least one argument.
You can make your list a bit more general like this:
data List a = Nil | Cons a (List a) deriving Show
Now we can write an instance of Monad
for this list*:
append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x (append xs ys)
instance Monad List where
return :: a -> List a
return x = Cons x Nil
(>>=) :: List a -> (a -> List b) -> List b
Nil >>= _ = Nil
Cons x xs >>= f = append (f x) (xs >>= f)
And now we can use it in do notation:
do
x <- Cons 5 Nil
Cons 42 Nil -- Note that this is the same as `return 42`
Internally, Haskell will rewrite this to:
Cons 5 Nil >>= (\x -> Cons 42 Nil)
Can you use the definition of (>>=)
to calculate the result of this expression with pen and paper?
Solution
Cons 5 Nil >>= (\x -> Cons 42 Nil)
= { using the definition of Cons x xs >>= f }
append ((\x -> Cons 42 Nil) 5) (Nil >>= (\x -> Cons 42 Nil))
= { applying the (\x -> Cons 42 Nil) lambda to the argument 5 }
append (Cons 42 Nil) (Nil >>= (\x -> Cons 42 Nil))
= { using the definition of append (Cons x xs) ys }
Cons 42 (append Nil (Nil >>= (\x -> Cons 42 Nil)))
= { using the definition of append Nil ys }
Cons 42 (Nil >>= (\x -> Cons 42 Nil))
= { using the definition of Nil >>= _ }
Cons 42 Nil
* Monad actually also requires that the type is an instance of Applicative
, but I have chosen to leave that out for this explanation.