{-# 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)