155 lines
2.6 KiB
Haskell
155 lines
2.6 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
module Exercises where
|
|
|
|
-- Rearrange.
|
|
--
|
|
-- 1
|
|
--
|
|
data Sum a b =
|
|
First b
|
|
| Second a
|
|
|
|
instance Functor (Sum e) where
|
|
fmap f (First a) = First (f a)
|
|
fmap f (Second b) = Second b
|
|
|
|
--
|
|
-- 2
|
|
--
|
|
data Company a c b =
|
|
DeepBlue a c
|
|
| Something b
|
|
|
|
instance Functor (Company e e') where
|
|
fmap f (Something b) = Something (f b)
|
|
fmap _ (DeepBlue a c) = DeepBlue a c
|
|
|
|
--
|
|
-- 3
|
|
--
|
|
data More b a =
|
|
L a b a
|
|
| R b a b
|
|
deriving (Eq, Show)
|
|
|
|
instance Functor (More x) where
|
|
fmap f (L a b a') = L (f a) b (f a')
|
|
fmap f (R b a b') = R b (f a) b'
|
|
|
|
-- Write Functor instances.
|
|
--
|
|
-- 1
|
|
--
|
|
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 x) = Desk x
|
|
|
|
--
|
|
-- 2
|
|
--
|
|
newtype K a b =
|
|
K a
|
|
|
|
instance Functor (K a) where
|
|
fmap _ (K x) = K x
|
|
|
|
--
|
|
-- 3
|
|
--
|
|
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
|
|
|
|
--
|
|
-- 4
|
|
--
|
|
data EvilGoateeConst a b =
|
|
GoatyConst b
|
|
|
|
instance Functor (EvilGoateeConst a) where
|
|
fmap f (GoatyConst x) = GoatyConst $ f x
|
|
|
|
--
|
|
-- 5
|
|
--
|
|
data LiftItOut f a = LiftItOut (f a)
|
|
|
|
instance Functor f => Functor (LiftItOut f) where
|
|
fmap f (LiftItOut g) = LiftItOut $ fmap f $ g
|
|
|
|
--
|
|
-- 6
|
|
--
|
|
data Parappa f g a =
|
|
DaWrappa (f a) (g a)
|
|
|
|
instance (Functor f, Functor g) => Functor (Parappa f g) where
|
|
fmap f (DaWrappa f1 f2) = DaWrappa (fmap f f1) (fmap f f2)
|
|
|
|
--
|
|
-- 7
|
|
--
|
|
data IgnoreOne f g a b =
|
|
IgnoringSomething (f a) (g b)
|
|
|
|
instance Functor g => Functor (IgnoreOne f g a) where
|
|
fmap f (IgnoringSomething f1 f2) = IgnoringSomething f1 $ fmap f f2
|
|
|
|
--
|
|
-- 8
|
|
--
|
|
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 f1 f2 f3) = Notorious f1 f2 $ fmap f f3
|
|
|
|
--
|
|
-- 9
|
|
--
|
|
data List a = Nil | Cons a (List a)
|
|
|
|
instance Functor List where
|
|
fmap f (Cons x y) = Cons (f x) (fmap f y)
|
|
fmap _ Nil = Nil
|
|
|
|
--
|
|
-- 10
|
|
--
|
|
data GoatLord a =
|
|
NoGoat
|
|
| OneGoat a
|
|
| MoreGoats (GoatLord a)
|
|
(GoatLord a)
|
|
(GoatLord a)
|
|
|
|
instance Functor GoatLord where
|
|
fmap _ NoGoat = NoGoat
|
|
fmap f (OneGoat x) = OneGoat $ f x
|
|
fmap f (MoreGoats x y z) = MoreGoats (g x) (g y) (g z)
|
|
where g t = fmap f t
|
|
|
|
--
|
|
-- 11
|
|
--
|
|
data TalkToMe a =
|
|
Halt
|
|
| Print String a
|
|
| Read (String -> a)
|
|
|
|
instance Functor TalkToMe where
|
|
fmap _ Halt = Halt
|
|
fmap f (Print x y) = Print x $ f y
|
|
fmap f (Read g) = Read (f . g)
|