{-# LANGUAGE InstanceSigs, KindSignatures #-}

class Monoid' a where
  mempty' :: a
  mappend' :: a -> a -> a

instance Monoid' [a] where
  mempty' :: [a]
  mempty' = []

  mappend' :: [a] -> [a] -> [a]
  mappend' x y = x ++ y


class Functor' (f :: * -> *) where
  fmap' :: (a -> b) -> f a -> f b

instance Functor' [] where
  fmap' :: (a -> b) -> [a] -> [b]
  fmap' = map
  -- map id xs = xs
  -- map (\ x -> f (g x)) xs = map f (map g xs)

instance Functor' Maybe where
  fmap' :: (a -> b) -> Maybe a -> Maybe b
  fmap' f Nothing = Nothing
  fmap' f (Just x) = Just (f x)

data Compose f g a = C (f (g a))
  deriving (Show)
-- Compose f g a ~ f (g a)

instance (Functor' f, Functor' g) => Functor' (Compose f g) where
  fmap' :: (a -> b) -> Compose f g a -> Compose f g b
  fmap' h (C x) = C (fmap' (fmap' h) x)
    -- h :: a -> b, h is a morphism from a to b
    -- x :: f (g a)
    -- fmap' h :: g a -> g b
    -- fmap' (fmap' h) :: f (g a) -> f (g b)
    -- fmap' (fmap' h) x :: f (g b)
    -- C (fmap' (fmap' h) x) :: Compose f g b
    
    -- by the functoriality of g, we have fmap' :: (a -> b) -> g a -> g b
    -- by the functoriality of f , we have fmap' :: (g a -> g b) -> f (g a) -> f (g b)



v :: Compose [] Maybe Int
v = C ([Just 1, Just 2, Nothing])

v2 :: Compose Maybe [] Int
v2 = C (Just [1,2, 3])

v3 :: Compose Maybe [] Int
v3 = C Nothing


safeHead :: [a] -> Maybe a  
safeHead [] = Nothing
safeHead (x:xs) = Just x


-- f :: a -> b
-- for any x :: [a], we have fmap' f :: [a] -> [b],
-- fmap' f :: Maybe a -> Maybe b

--- [a] -safeHead-> Maybe a
---  | fmap' f        | fmap' f
--- [b] -safehead-> Maybe b

-- safeHead (fmap' f x) = fmap' f (safeHead x)
-- x = [a1, a2,...an]
-- safeHead [f a1, f a2, ... f an] = Just (f a1)
-- fmap' f (safeHead [a1, ... an]) = fmap' f (Just a1) = Just (f a1)

data Tree a = Leaf | Node a (Tree a) (Tree a)
  deriving (Show)

instance Functor' Tree where
  fmap' :: (a -> b) -> Tree a -> Tree b
  fmap' f Leaf = Leaf
  fmap' f (Node x l r) = Node (f x) (fmap' f l) (fmap' f r)

traversal :: Tree a -> [a]
traversal Leaf = []
traversal (Node x l r) = traversal l ++ [x] ++ traversal r

--- Tree a -traversal-> [a]
---  | fmap' f        | fmap' f
--- Tree b -traversal-> [b]

-- Node x Leaf Leaf -> [x] -> [f x]

-- Node (f x) Leaf Leaf -> [f x]