Complete chapter 16

16-functor/16.10-instances-of-func.md

@@ -0,0 +1,2 @@
+# Exercises: Instances of Func
+see src/func.hs

16-functor/16.11-possibly.md

@@ -0,0 +1,13 @@
+# Chapter 16
+## Maybe
+### Exercise: Possibly
+see src/Possibly.hs
+
+## Either
+### Short Exercise
+### Exercise 1
+see src/Sum.hs
+
+### Excercise 2
+Functor expects a type with kind `* -> *`. `Sum` and `Either` are of kind `* -> * -> *` In order to reduce it to `* -> *` we need to apply one type of kind `*`, but the only one we can apply right now is the first in the list.
+

16-functor/16.17-chapter-exercises.md

@@ -0,0 +1,13 @@
+# Chapter Excercises
+## Can a valid Functor be written?
+1. No, Bool is of kind `*`
+2. Yes, see src/chptexc.hs
+3. Yes, see src/chptexc.hs
+4. The first f in `outF :: f (Mu f)` implies that f is of kind `* -> *`. `Mu` takes this f to return a type, so it's kind is `(* -> *) -> *`. This means we can't make a Functor from this as this is not `* -> *`
+5. No, D is of kind `*`
+
+## Rearrange
+see src/chptexc.hs
+
+## Write
+see src/chptexc.hs

16-functor/16.4-be-kind.md

@@ -0,0 +1,4 @@
+# Excercises: Be Kind
+1. `a` is of kind `*`
+2. `b` is of kind `* -> *`, `T` has kind `* -> *`
+3. `c` is of kinde `* -> * -> *`

16-functor/16.7-heavy-lifting.md

@@ -0,0 +1,13 @@
+# Exercises: Heavy Lifting
+1. `a = fmap (+1) $ read "[1]" :: [Int]`
+2. `b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"])`
+3. `c = fmap (*2) (\x -> x - 2)`
+4. `d = fmap ((return '1' ++) . show) (\x -> [x,1..3])`
+5. see block below
+
+```
+e :: IO Integer
+e = let ioi = readIO "1" :: IO Integer
+        changed = fmap read (fmap (("123"++) . show) ioi)
+    in fmap (*3) changed
+```

16-functor/16.7-typecheck.md

@@ -0,0 +1,20 @@
+# Wait, how does that even typecheck
+
+```
+(.) :: (b -> c) -> (a -> b) -> a -> c
+--       fmap        fmap
+fmap :: Functor f => (m -> n) -> f m -> f n
+fmap :: Functor g => (x -> y) -> g x -> g y
+```
+Let's typecheck `fmap . fmap.`.
+
+1. First, it's important to note that `fmap` is a function that takes a function `m -> n` and returns a function `f m -> f n`. 
+2. Using that information we see that `a` is actually `m -> n`.
+3. We also see that `b` is actually `f m -> f n` **and** `x -> y`, so `x` has to be `f m` and `y` has to be `f n`. 
+4. We can then also conclude that `g x` is `g (f m)` and `g y` is `g (f n)`
+
+Armed with this knowledge, we can apply fmap to (.) a first time
+`(fmap.) :: (Functor g) => (a -> (f m -> f n)) -> a -> g (f m) -> g (f n)`
+ 
+ And now we apply it a second time:
+ `(fmap . fmap) :: (Functor g, Functor f) => (m -> n) -> g (f m) -> g (f n)`

16-functor/src/Possibly.hs

@@ -0,0 +1,7 @@
+module Possibly where
+
+data Possibly a = LolNope | Yeppers a deriving (Eq, Show)
+
+instance Functor Possibly where
+    fmap _ LolNope = LolNope
+    fmap f (Yeppers a) = Yeppers $ f a

16-functor/src/Sum.hs

@@ -0,0 +1,7 @@
+module Sum where
+
+data Sum a b = First a | Second b deriving (Eq, Show)
+
+instance Functor (Sum a) where
+    fmap f (Second b) = Second $ f b
+    fmap _ a = a

16-functor/src/chptexc.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE FlexibleInstances #-}
+module ChptExc where
+
+data BoolAndSomethingElse a = False' a | True' a deriving (Eq, Show)
+instance Functor BoolAndSomethingElse where
+    fmap f (False' a) = False' (f a)
+    fmap f (True' a) = True' (f a)
+
+data BoolAndMaybeSomethingElse a = Falsish | Truish a deriving (Eq, Show)
+instance Functor BoolAndMaybeSomethingElse where
+    fmap f (Truish a) = Truish (f a)
+    fmap _ Falsish = Falsish
+
+-- Rearrange
+data Sum a b = First a | Second b
+instance Functor (Sum e) where
+    fmap _ (First a) = First a
+    fmap f (Second b) = Second (f b)
+
+data Company a b c = DeepBlue a c | Something b
+instance Functor (Company e e') where
+    fmap _ (Something b) = Something b
+    fmap f (DeepBlue a c) = DeepBlue a (f c)
+
+data More a b  = L a b a | R b a b deriving (Eq, Show)
+instance Functor (More a) where
+    fmap f (L a b a') = L a (f b) a'
+    fmap f (R b a b') = R (f b) a (f b')
+
+-- Write
+data Quant a b = Finance | Desk a | Bloor b
+instance Functor (Quant a) where
+    fmap f (Bloor b) = Bloor (f b)
+    fmap _ Finance = Finance
+    fmap _ (Desk a) = Desk a
+
+data K a b = K a
+instance Functor (K a) where
+    fmap _ (K a) = K a
+
+newtype Flip f a b = Flip (f b a) deriving (Eq, Show)
+instance Functor (Flip K a) where
+    fmap f (Flip (K a)) = Flip $ K (f a)
+
+data EvilGoateeConst a b = GoatyConst b
+instance Functor (EvilGoateeConst a) where
+    fmap f (GoatyConst b) = GoatyConst (f b)
+
+data LiftItOut f a = LiftItOut (f a)
+instance Functor f => Functor (LiftItOut f) where
+    fmap f (LiftItOut fa) = LiftItOut $ fmap f fa
+
+data Parappa f g a = DaWrappa (f a) (g a)
+instance (Functor f, Functor g) => Functor (Parappa f g) where
+    fmap f (DaWrappa fa ga) = DaWrappa (fmap f fa) (fmap f ga)
+
+data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
+instance (Functor f, Functor g) => Functor (IgnoreOne f g a) where
+    fmap f (IgnoringSomething fa ga) = IgnoringSomething fa (fmap f ga)
+
+data Notorious g o a t = Notorious (g o) (g a) (g t)
+instance (Functor g) => Functor (Notorious g o a) where
+    fmap f (Notorious go ga gt) = Notorious go ga (fmap f gt)
+
+data List a = Nil | Cons a (List a)
+instance Functor List where
+    fmap _ Nil = Nil
+    fmap f (Cons a l) = Cons (f a) (fmap f l)
+
+data GoatLord a = NoGoat | OneGoat a |
+                  MoreGoats (GoatLord a) (GoatLord a) (GoatLord a)
+instance Functor GoatLord where
+    fmap _ NoGoat = NoGoat
+    fmap f (OneGoat a) = OneGoat (f a)
+    fmap f (MoreGoats a b c) = MoreGoats (fmap f a) (fmap f b) (fmap f c)
+
+data TalkToMe a = Halt | Print String a | Read (String -> a)
+instance Functor TalkToMe where
+    fmap _ Halt = Halt
+    fmap f (Print s a) = Print s (f a)
+    fmap f (Read a) = Read (fmap f a) 

16-functor/src/func.hs

@@ -0,0 +1,141 @@
+module Func where
+
+import Test.QuickCheck
+import Test.QuickCheck.Function
+
+functorIdentity :: (Functor f, Eq (f a)) => f a -> Bool
+functorIdentity f = fmap id f == f
+
+functorCompose :: (Eq (f c), Functor f) => (a -> b) -> (b -> c) -> f a -> Bool
+functorCompose f g x = (fmap g (fmap f x)) == (fmap (g . f) x)
+
+functorCompose' :: (Eq (f c), Functor f) => f a -> Fun a b -> Fun b c -> Bool
+functorCompose' x (Fun _ f) (Fun _ g) =
+    (fmap (g . f) x) == (fmap g . fmap f $ x)
+
+-- 1
+newtype Identity a = Identity a deriving (Eq, Show)
+instance Functor Identity where
+    fmap f (Identity a) = Identity (f a)
+instance Arbitrary a => Arbitrary (Identity a) where
+    arbitrary = do
+        a <- arbitrary
+        return $ Identity a
+type IdentId = Identity Int -> Bool
+type IdentComp = Identity Int -> Fun Int String -> Fun String Float -> Bool
+
+-- 2
+data Pair a = Pair a a deriving (Eq, Show)
+instance Functor Pair where
+    fmap f (Pair a a') = Pair (f a) (f a')
+instance Arbitrary a => Arbitrary (Pair a) where
+    arbitrary = do
+        a <- arbitrary
+        a' <- arbitrary
+        return $ Pair a a'
+type PairId = Pair Int -> Bool
+type PairComp = Pair Int -> Fun Int String -> Fun String Float -> Bool
+
+-- 3
+data Two a b = Two a b deriving (Eq, Show)
+instance Functor (Two a) where
+    fmap f (Two a b) = Two a (f b)
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+    arbitrary = do
+        a <- arbitrary
+        b <- arbitrary
+        return $ Two a b
+type TwoId = Two Int String -> Bool
+type TwoComp = Two Int String -> Fun String Int -> Fun Int Float -> Bool 
+
+-- 4
+data Three a b c = Three a b c deriving (Eq, Show)
+instance Functor (Three a b) where
+    fmap f (Three a b c) = Three a b (f c)
+instance (Arbitrary a, Arbitrary b, Arbitrary c) 
+    => Arbitrary (Three a b c) where
+        arbitrary = do
+            a <- arbitrary
+            b <- arbitrary
+            c <- arbitrary
+            return $ Three a b c
+type ThreeId = Three Int String Float -> Bool
+type ThreeComp = Three Int String Float ->
+                 Fun Float String ->
+                 Fun String Int ->
+                 Bool
+
+-- 5
+data Three' a b = Three' a b b deriving (Eq, Show)
+instance Functor (Three' a) where
+    fmap f (Three' a b b') = Three' a (f b) (f b')
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where
+    arbitrary = do
+        a <- arbitrary
+        b <- arbitrary
+        b' <- arbitrary
+        return $ Three' a b b'
+type Three'Id = Three' Int String -> Bool
+type Three'Comp = Three' Int String ->
+                  Fun String Float ->
+                  Fun Float Int ->
+                  Bool
+
+-- 6
+data Four a b c d = Four a b c d deriving (Eq, Show)
+instance Functor (Four a b c) where
+    fmap f (Four a b c d) = Four a b c (f d)
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
+    => Arbitrary (Four a b c d) where
+        arbitrary = do
+            a <- arbitrary
+            b <- arbitrary
+            c <- arbitrary
+            d <- arbitrary
+            return $ Four a b c d
+type FourId = Four Int String Float Ordering -> Bool
+type FourComp = Four Int String Float Ordering ->
+                 Fun Ordering Int ->
+                 Fun Int String ->
+                 Bool
+
+-- 7
+data Four' a b = Four' a a a b deriving (Eq, Show)
+instance Functor (Four' a) where
+    fmap f (Four' a a' a'' b) = Four' a a' a'' (f b)
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where
+    arbitrary = do
+        a <- arbitrary
+        a' <- arbitrary
+        a'' <- arbitrary
+        b <- arbitrary
+        return $ Four' a a' a'' b
+type Four'Id = Four' Int String -> Bool
+type Four'Comp = Four' Int String ->
+                 Fun String Bool ->
+                 Fun Bool Float ->
+                 Bool
+                
+-- 8
+-- This is not possible because Trivial is of kind *
+-- And you need * -> *.
+
+main :: IO ()
+main = do
+    putStrLn "Functor Identity Tests"
+    quickCheck (functorIdentity :: IdentId)
+    quickCheck (functorIdentity :: PairId)
+    quickCheck (functorIdentity :: TwoId)
+    quickCheck (functorIdentity :: ThreeId)
+    quickCheck (functorIdentity :: Three'Id)
+    quickCheck (functorIdentity :: FourId)
+    quickCheck (functorIdentity :: Four'Id)
+
+    putStrLn "Functor Composition Tests"
+    quickCheck (functorCompose' :: IdentComp)
+    quickCheck (functorCompose' :: PairComp)
+    quickCheck (functorCompose' :: TwoComp)
+    quickCheck (functorCompose' :: ThreeComp)
+    quickCheck (functorCompose' :: Three'Comp)
+    quickCheck (functorCompose' :: FourComp)
+    quickCheck (functorCompose' :: Four'Comp)