Chapter 12 refactoring

Author: moartc

src/chapter-12/examples.hs

@@ -1,54 +1,55 @@
+{-# LANGUAGE InstanceSigs #-}
+
 import Control.Monad
 import Data.Char
 
 -- ===================  Functors
-
 data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)
 
 instance Functor Tree where
+  fmap :: (a -> b) -> Tree a -> Tree b
   fmap g (Leaf x) = Leaf (g x)
   fmap g (Node l r) = Node (fmap g l) (fmap g r)
 
 ex1 :: Tree Int
-ex1 = fmap length (Leaf "abc")
+ex1 = fmap length (Leaf "abc") -- Leaf 3
 
 ex2 :: Tree Bool
-ex2 = fmap even (Node (Leaf 1) (Leaf 2))
+ex2 = fmap even (Node (Leaf 1) (Leaf 2)) -- Node (Leaf False) (Leaf True)
 
 inc :: Functor f => f Int -> f Int
 inc = fmap (+ 1)
 
 ex3 :: [Int]
-ex3 = inc [1, 2, 3, 4, 5]
+ex3 = inc [1, 2, 3, 4, 5] -- [2,3,4,5,6]
 
 ex4 :: Maybe Int
-ex4 = inc (Just 1)
+ex4 = inc (Just 1) -- Just 2
 
 -- =================== Applicatives
-
 ex5 :: Maybe Integer
-ex5 = pure (+ 1) <*> Just 1
+ex5 = pure (+ 1) <*> Just 1 -- Just 2
 
 ex6 :: Maybe Integer
-ex6 = pure (+) <*> Just 1 <*> Just 2
+ex6 = pure (+) <*> Just 1 <*> Just 2 -- Just 3
 
 ex7 :: Maybe Integer
-ex7 = pure (+) <*> Nothing <*> Just 2
+ex7 = pure (+) <*> Nothing <*> Just 2 -- Nothing
 
 ex8 :: [Integer]
-ex8 = pure (+ 1) <*> [1, 2, 3]
+ex8 = pure (+ 1) <*> [1, 2, 3] -- [2,3,4]
 
 ex9 :: [Integer]
-ex9 = pure (+) <*> [1] <*> [2]
+ex9 = pure (+) <*> [1] <*> [2] -- [3]
 
 ex10 :: [Integer]
-ex10 = pure (*) <*> [1, 2] <*> [3, 4]
+ex10 = pure (*) <*> [1, 2] <*> [3, 4] -- [3,4,6,8]
 
 prods :: [Int] -> [Int] -> [Int]
-prods xs ys = [x * y | x <- xs, y <- ys]
+prods xs ys = [x * y | x <- xs, y <- ys] -- [3,4,6,8]
 
 ex11 :: [Int]
-ex11 = prods [1, 2] [3, 4]
+ex11 = prods [1, 2] [3, 4] -- [3,4,6,8]
 
 prods2 :: [Int] -> [Int] -> [Int]
 prods2 xs ys = pure (*) <*> xs <*> ys
@@ -60,21 +61,20 @@ getChars :: Int -> IO String
 getChars n = sequenceA (replicate n getChar)
 
 ex13 :: [Int]
-ex13 = (+ 1) <$> [1, 2]
+ex13 = (+ 1) <$> [1, 2] -- [2,3]
 
 ex14 :: [Integer]
-ex14 = (*) <$> [1, 2, 3] <*> [4, 5, 6]
+ex14 = (*) <$> [1, 2, 3] <*> [4, 5, 6] -- [4,5,6,8,10,12,12,15,18]
 
 -- =================== Monads
-
 data Expr = Val Int | Div Expr Expr
 
 eval :: Expr -> Int
 eval (Val n) = n
 eval (Div x y) = eval x `div` eval y
 
 ex15 :: Int
-ex15 = eval (Div (Val 1) (Val 0))
+ex15 = eval (Div (Val 1) (Val 0)) -- Exception: divide by zero
 
 safediv :: Int -> Int -> Maybe Int
 safediv _ 0 = Nothing
@@ -89,10 +89,10 @@ eval2 (Div x y) = case eval2 x of
     Just m -> safediv n m
 
 ex16a :: Maybe Int
-ex16a = eval2 (Div (Val 4) (Val 2))
+ex16a = eval2 (Div (Val 4) (Val 2)) -- Just 2
 
 ex16b :: Maybe Int
-ex16b = eval2 (Div (Val 1) (Val 0))
+ex16b = eval2 (Div (Val 1) (Val 0)) -- Nothing
 
 eval3 :: Expr -> Maybe Int
 eval3 (Val n) = Just n
@@ -102,10 +102,10 @@ eval3 (Div x y) =
       safediv n m
 
 ex17a :: Maybe Int
-ex17a = eval3 (Div (Val 4) (Val 2))
+ex17a = eval3 (Div (Val 4) (Val 2)) -- Just 2
 
 ex17b :: Maybe Int
-ex17b = eval3 (Div (Val 1) (Val 0))
+ex17b = eval3 (Div (Val 1) (Val 0)) -- Nothing
 
 eval4 :: Expr -> Maybe Int
 eval4 (Val n) = Just n
@@ -115,10 +115,10 @@ eval4 (Div x y) = do
   safediv n m
 
 ex18a :: Maybe Int
-ex18a = eval4 (Div (Val 4) (Val 2))
+ex18a = eval4 (Div (Val 4) (Val 2)) -- Just 2
 
 ex18b :: Maybe Int
-ex18b = eval4 (Div (Val 1) (Val 0))
+ex18b = eval4 (Div (Val 1) (Val 0)) -- Nothing
 
 pairs :: [a] -> [b] -> [(a, b)]
 pairs xs ys = do
@@ -140,18 +140,18 @@ rlabel (Node l r) n = (Node l' r', n'')
     (r', n'') = rlabel r n'
 
 ex19 :: Tree Int
-ex19 = fst (rlabel tree 0)
+ex19 = fst (rlabel tree 0) -- Node (Node (Leaf 0) (Leaf 1)) (Leaf 2)
 
 conv :: Char -> Maybe Int
 conv c
   | isDigit c = Just $ digitToInt c
   | otherwise = Nothing
 
 ex20 :: Maybe [Int]
-ex20 = mapM conv "1234"
+ex20 = mapM conv "1234" -- Just [1,2,3,4]
 
 ex21 :: [[Integer]]
-ex21 = filterM (\x -> [True, False]) [1, 2, 3]
+ex21 = filterM (\x -> [True, False]) [1, 2, 3] -- [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]]
 
 join' :: Monad m => m (m a) -> m a
 join' mmx = do
@@ -160,13 +160,13 @@ join' mmx = do
   return x
 
 ex22 :: [Integer]
-ex22 = join' [[1, 2], [3, 4], [5, 6]]
+ex22 = join' [[1, 2], [3, 4], [5, 6]] -- [1,2,3,4,5,6]
 
 ex23 :: Maybe Integer
-ex23 = join' (Just (Just 1))
+ex23 = join' (Just (Just 1)) -- Just 1
 
 ex24 :: Maybe a
-ex24 = join' (Just Nothing)
+ex24 = join' (Just Nothing) -- Nothing
 
 ex25 :: Maybe a
-ex25 = join' Nothing
+ex25 = join' Nothing -- Nothing

src/chapter-12/exercises.hs

@@ -9,28 +9,35 @@ instance Functor Tree where
   fmap g (Node a x b) = Node (fmap g a) (g x) (fmap g b)
 
 -- Exercise 2
-instance Functor ((->) a) where
-  --   fmap :: (x -> y) -> ((->) a x) -> ((->) a y)
-  --   fmap :: (x -> y) -> (a -> x) -> (a -> y)
-  --   fmap f1 f2  = \x -> f1 (f2 x)
-  --   fmap f1 f2  = f1 . f2
-  fmap = (.)
+-- instance Functor ((->) a) where
+--   --   fmap :: (x -> y) -> ((->) a x) -> ((->) a y)
+--   --   fmap :: (x -> y) -> (a -> x) -> (a -> y)
+--   --   fmap f1 f2  = \x -> f1 (f2 x)
+--   --   fmap f1 f2  = f1 . f2
+--   fmap = (.)
+
+-- instance Functor [] where
+--   --   fmap :: (x -> y) -> ((->) a x) -> ((->) a y)
+--   --   fmap :: (x -> y) -> (a -> x) -> (a -> y)
+--   --   fmap f1 f2  = \x -> f1 (f2 x)
+--   --   fmap f1 f2  = f1 . f2
+--   fmap = (.)
 
 -- Exercise 3
-instance Applicative ((->) r) where
-  pure :: a -> f a
-  --   pure :: a -> (r -> a)
-  --   pure a = \_ -> a
-  --   pure a = const a
-  pure = const
-
-  --   (<*>) :: f (a -> b) -> f a -> f b
-  --   (<*>) :: ((->) r) (a -> b) -> ((->) r) a -> ((->) r) b
-  --   (<*>) :: (->) r (a -> b) -> (->) r a -> (->) r b
-  (<*>) :: (r -> a -> b) -> (r -> a) -> (r -> b)
-  --   (<*>) f g x = f x (g x)
-  --   (<*>) f g = \x -> f x (g x)
-  f <*> g = \x -> f x (g x)
+-- instance Applicative ((->) r) where
+--   pure :: a -> f a
+--   --   pure :: a -> (r -> a)
+--   --   pure a = \_ -> a
+--   --   pure a = const a
+--   pure = const
+
+--   --   (<*>) :: f (a -> b) -> f a -> f b
+--   --   (<*>) :: ((->) r) (a -> b) -> ((->) r) a -> ((->) r) b
+--   --   (<*>) :: (->) r (a -> b) -> (->) r a -> (->) r b
+--   (<*>) :: (r -> a -> b) -> (r -> a) -> (r -> b)
+--   --   (<*>) f g x = f x (g x)
+--   --   (<*>) f g = \x -> f x (g x)
+--   f <*> g = \x -> f x (g x)
 
 -- Exercise 4
 newtype ZipList a = Z [a] deriving (Show)