Fix chapter 18

18-monad/src/EitherMonad.hs

@@ -44,11 +44,11 @@ main = do
 -- We can't just do
 -- m >>= (f >>= g) because f is not of type (Monoid m => m b)
 -- We want to pass an m to an h
--- m >>= h 
+-- m >>= h
 -- where h is to be determined, we know it is of form (Monoid m => a -> m b)
 -- and it should be based on f >>= g, this doesn't work, but we could apply
 -- f to an `a` and provide that to the:
 -- h x = f x >>= g
--- This is can be done via anonymous function: 
+-- This is can be done via anonymous function:
 -- m >>= (\x -> f x >>= g)
 -- join (fmap (\x -> join (fmap g (f x))) m)

18-monad/src/bind.hs

@@ -3,4 +3,4 @@ module Bind where
 import Control.Monad (join)
 
 bind :: Monad m => (a -> m b) -> m a -> m b
-bind = join . fmap f
+bind f = join . fmap f

18-monad/src/examples.hs

@@ -1,6 +1,7 @@
 module Examples where
 
 import Control.Monad (join)
+import Control.Applicative (liftA3)
 
 twiceWhenEven :: [Integer] -> [Integer]
 twiceWhenEven xs = do
@@ -28,7 +29,7 @@ noEmpty s = Just s
 noNegative :: Int -> Maybe Int
 noNegative n | n >= 0 = Just n
              | otherwise = Nothing
-            
+
 weightCheck :: Cow -> Maybe Cow
 weightCheck c =
     let w = weight c
@@ -90,7 +91,7 @@ mkSphericalCow''' name' age' weight' =
 -- (fmap :: (String -> Maybe Cow) -> Maybe String -> Maybe (Maybe Cow))
 -- Using join, reduces this to jsut a Maybe Cow, this gives us the
 -- Maybe Cow
-                        
+
 -- mkSphericalCow''' :: String -> Int -> Int -> Maybe Cow
 -- mkSphericalCow''' name' age' weight' = z name' age' weight'
 --     where z :: String -> Int -> Int -> Maybe Cow
@@ -120,5 +121,7 @@ doSomething' n = do
     pure (a, b, c)
 
 doSomething'' :: Integer -> Maybe (Integer, Integer, String)
-doSomething'' n =
+doSomething'' n = liftA3 (,,) a b c
-    (pure g) <*> (f n)
+    where a = f n
+          b = join $ pure g <*> a -- need join here...
+          c = join $ pure h <*> b -- need join here...

18-monad/src/functions.hs

@@ -10,7 +10,7 @@ l1 :: Monad m => (a -> b) -> m a -> m b
 l1 f x = do
     a' <- x
     return $ f a'
-l1 f x = x >>= (return . f)
+-- l1 f x = x >>= (return . f)
 -- with fmap :)
 -- l1 = fmap
 
@@ -20,7 +20,7 @@ l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c
 l2 f x y = do
     a' <- x
     b  <- y
-    return $ f a' b 
+    return $ f a' b
 -- l2 f x y = x >>= (\a -> y >>= \b -> return $ f a b)
 -- with fmap
 -- l2 f x y = (fmap f x) <*> y

18-monad/src/instances.hs

@@ -4,7 +4,6 @@ import Test.QuickCheck
 import Test.QuickCheck.Checkers
 import Test.QuickCheck.Classes
 
--- import Control.Monad (join)
 import Control.Applicative (liftA2)
 
 -- 1
@@ -74,9 +73,7 @@ instance Monoid (List a) where
     mappend Nil l = l
     mappend (Cons a l) l' = Cons a (mappend l l')
 instance Applicative List where
-    {-# INLINE pure #-}
     pure = flip Cons Nil
-    {-# INLINE (<*>) #-}
     Nil <*> _ = Nil
     _ <*> Nil = Nil
     (Cons f fl) <*> as = (fmap f as) `mappend` (fl <*> as)
@@ -85,44 +82,22 @@ instance Monad List where
     Nil >>= _ = Nil
     (Cons a l) >>= k = (k a) `mappend` (l >>= k)
 
-    -- I originally had the above, because I thought that you could not
+-- The following is needed to get an Arbitrary for the List. I got the idea
-    -- use join, but I found a solution online that uses join. Trying to
+-- from looking at how it is done for []. It's not very efficient though.
-    -- understand: 
-    -- join is defined as (join x = x >>= id)
-    -- You might think, wait a minute? id is (a -> a) and thus doesn't fit the
-    -- bill of (a -> m b), but let's look at things more closely
-    --
-    -- (>>=) :: m a -> (a -> m b) -> m b
-    -- a here is the type of x :: (m a')
-    -- b here is the inner type of x :: a', 
-    -- updating gives us:
-    -- (>>=) :: m (m a') -> (m a' -> m a') -> m a'
-    -- and we see that we can pass the id function to it
-
-    -- This turns the >>= definition into a recursive one where the second time
-    -- the function is the id, which will join it all
-    
-    -- unfortunately this crashes when testing the monad laws ... Why?
-    -- because this never ends... You get
-    -- fmap id (fmap id (... (fmap id (fmap f as))))
-    -- as >>= f = join $ fmap f as
-    
--- toList :: [a] -> List a
--- toList [] = Nil
--- toList (x:xs) = Cons x $ toList xs
-
 replicateM' :: Applicative m => Int -> m a -> m (List a)
 replicateM' cnt0 f = loop cnt0
     where loop cnt
                 | cnt <= 0 = pure Nil
                 | otherwise = liftA2 Cons f (loop (cnt - 1))
-  
+
 listOf' :: Gen a -> Gen (List a)
 listOf' gen = sized $ \n ->
     do k <- choose (0,n)
        replicateM' k gen
 
-
+-- toList :: [a] -> List a
+-- toList [] = Nil
+-- toList (x:xs) = Cons x $ toList xs
 instance Arbitrary a => Arbitrary (List a) where
     arbitrary = listOf' arbitrary
     -- arbitrary = fmap toList (listOf arbitrary)