diff --git a/16-functor/16.10-instances-of-func.md b/16-functor/16.10-instances-of-func.md new file mode 100644 index 0000000..d055b0b --- /dev/null +++ b/16-functor/16.10-instances-of-func.md @@ -0,0 +1,2 @@ +# Exercises: Instances of Func +see src/func.hs \ No newline at end of file diff --git a/16-functor/16.11-possibly.md b/16-functor/16.11-possibly.md new file mode 100644 index 0000000..a0f0a20 --- /dev/null +++ b/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. + diff --git a/16-functor/16.17-chapter-exercises.md b/16-functor/16.17-chapter-exercises.md new file mode 100644 index 0000000..6f57f83 --- /dev/null +++ b/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 diff --git a/16-functor/16.4-be-kind.md b/16-functor/16.4-be-kind.md new file mode 100644 index 0000000..ae0af65 --- /dev/null +++ b/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 `* -> * -> *` diff --git a/16-functor/16.7-heavy-lifting.md b/16-functor/16.7-heavy-lifting.md new file mode 100644 index 0000000..3854d22 --- /dev/null +++ b/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 +``` \ No newline at end of file diff --git a/16-functor/16.7-typecheck.md b/16-functor/16.7-typecheck.md new file mode 100644 index 0000000..e92e0c3 --- /dev/null +++ b/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)` diff --git a/16-functor/src/Possibly.hs b/16-functor/src/Possibly.hs new file mode 100644 index 0000000..437b8d2 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/16-functor/src/Sum.hs b/16-functor/src/Sum.hs new file mode 100644 index 0000000..c96468d --- /dev/null +++ b/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 \ No newline at end of file diff --git a/16-functor/src/chptexc.hs b/16-functor/src/chptexc.hs new file mode 100644 index 0000000..76a5360 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/16-functor/src/func.hs b/16-functor/src/func.hs new file mode 100644 index 0000000..d60e31e --- /dev/null +++ b/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) \ No newline at end of file