{-# LANGUAGE DeriveGeneric,
             TypeOperators,
             TypeFamilies,
             FlexibleContexts,
             DefaultSignatures #-}

data T a b = Q | N a b deriving Show


data Choice = I Int
            | C Char
            | B Choice Bool
            | S Choice deriving Show
            
instance (Eq a , Eq b ) => Eq (T a b) where
   Q == Q               = True
   (N x1 y1)== (N x2 y2) = x1 == x2 && y1 == y2
   _ == _                = False

instance Eq Choice where
  (I i1) == (I i2) = i1 == i2
  (C c1) == (C c2) = c1 == c2
  (B c1 b1) == (B c2 b2) = c1 == c2 && b1 == b2
  (S c1) == (S c2) = c1 == c2
  _ == _ = False

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

instance Eq a => (Eq (Tree a)) where
  Leaf a1 == Leaf a2 = a1 == a2
  (Node n1 n2) == (Node n3 n4) = n1 == n3 && n2 == n4
  _ == _ = False

data Rose a = Fork a [Rose a]

instance Eq a => Eq (Rose a) where
  (Fork a as) == (Fork b bs) = a == b && as == bs

{- Make sure that you can find the patterns for writing instances of Eq type class.
A pattern for implementing Eq class:
1, For each constructor, we introduce each parameter(field) of which such that we can check the equalities of its parameters(fields) respectively and combine the result by (&&).
2, For the other cases, i.e. the constructor are not the same, we just return False
-}
-- Surely, this can be implemented automatically. 
-- The idea is to fulfil the generalization of algebric data types

data U = U deriving Show -- ()
-- |  product (a,b)  :*: in GHC.Generic
data a :*: b = a :*: b deriving (Show, Eq)
-- |  sum  (Left a | Right b)  :+: in GHC.Generic
data a :+: b = L a | R b deriving (Show, Eq)

-- Haskell can generate Generic instances automatically by using driving keyword.
-- Generic has kind * -> Constraint. More generally, it should have a polymorphic kind, i.e. k -> Constraint, 
-- since you need to derive some type classes with 1 or more type parameter like the Typeable class.
-- However, the designer doesn't do this since he thinks generating class instances with two more parameters
-- automatically is rare. 

-- Therefore with the following you can derive type class with kind * -> Constraint such as Eq, Show, etc.
-- but not (* -> *) -> Constraint
class Generic a where
      type Rep a :: * -- more generally it should have * -> * . See Generic1
      from :: a -> Rep a       
      to   :: Rep a -> a  

{-  With the following Generic1 class, you can define functors, foldable classes.
 We will discuss it next time.      
class Generic1 a where
      type Rep1 a :: * -> *
      from1 :: a -> Rep1 a p
      to1   :: Rep1 a p -> a
and if you want to derive Bifunctor, it will be out of capability of GHC.Generic.
Like I said, this is possible, but the designer doesn't want to complicate the design.
You can do it your self.
-}
instance Generic Bool where
  type Rep Bool = U :+: U
  from False = L U
  from True  = R U
  to (L U) = False
  to (R U) = True
  

-- data [] a = [] | a : [a]
instance Generic [a] where
  type Rep [a] = U :+: (a :*: [a])
  from [] = L U
  from (x:xs) = R (x :*: xs)
  to (L U) = []
  to (R (x:*:xs)) = x:xs

-- write instance for Rose tree by yourself

-- This part should be written by library designer.
class GEq a where
  geq :: a -> a -> Bool
  -- For library user:
  -- You can give a default definition if the data
  -- type is an instance of Generic type class.
  -- Since the Generic instance can be generated
  -- by using deriving keyword in GHC, you do not
  -- need actually to implement it. All you need
  -- to do is to write deriving Generic and an empty
  -- GEq instance since the default function is in the class.

  -- For library designer:
  -- You need to define the instances for the type class
  -- you need to define for :*: , :+:, U, and the other type operators
  -- with the default functions.
  
  default geq :: (Generic a, GEq (Rep a)) => a -> a -> Bool
  geq = defaultEq

instance (GEq a , GEq b) => GEq (a :+: b) where
         geq (L a1) (L a2) = geq a1 a2
         geq (R b1) (R b2) = geq b1 b2
         geq _ _ = False

instance (GEq a, GEq b) => GEq (a :*: b) where
         geq (a1 :*: b1) (a2 :*: b2) = geq a1 a2 && geq b1 b2

instance GEq U where
         geq U U = True
     
instance GEq Bool

defaultEq :: (Generic a , GEq (Rep a)) => a -> a -> Bool
defaultEq x y = geq (from x) (from y)

data List a = Nil | Cons a (List a) deriving Show
-- Generated by the compiler
instance Generic a => Generic (List a) where
    type Rep (List a) = U :+: (a :*: (List a)) 
    from Nil = L U
    from (Cons x xs) = R (x :*: xs)
    to (L U) = Nil
    to (R (x :*: xs)) = Cons x xs
-- Written by library users
instance (GEq a , Generic a)  => (GEq (List a))
