content: -- D. Sannella. M Fourman, H. Peng and P. Wadler
  -- Introduction to Computation: Haskell, Logic and Automata
  -- Undergraduate Topics in Computer Science, Springer (2021)
  -- ISBN 978-3-030-76907
  
  -- Chapter 24 : Type Classes
  
  module Chap24_type_classes where
  
  -- Bundling types with functions
  
  -- The following function definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (elem)
  
  -- elem :: Eq a => a -> [a] -> Bool
  -- x `elem` []     = False
  -- x `elem` (y:ys) = x==y || x `elem` ys
  
  data Season = Winter | Spring | Summer | Fall
    deriving (Eq,Show)
  
  -- The following type definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Maybe, Nothing, Just)
  
  -- data Maybe a = Nothing | Just a
  --   deriving (Eq,Show)
  
  -- Declaring instances of type classes
  
  -- The following type class definition and its instances for Char, (a,b) and [a] are commented out because they
  -- are already in the Prelude.
  -- You can hide that definition and its instances to allow them to be re-defined by putting the following at the
  -- top of this module:
  -- import Prelude hiding (Eq, (==))
  
  -- class Eq a where
  --   (==) :: a -> a -> Bool
  
  -- instance Eq Char where
  --   x == y = ord x == ord y
  
  -- instance (Eq a, Eq b) => Eq (a,b) where
  --   (u,v) == (x,y) = (u == x) && (v == y)
  
  -- instance Eq a => Eq [a] where
  --   [] == []     = True
  --   [] == y:ys   = False
  --   x:xs == []   = False
  --   x:xs == y:ys = (x == y) && (xs == ys)
  
  data Exp = Lit Int
           | Add Exp Exp
           | Mul Exp Exp
    deriving Read
  
  -- showExp and evalExp are from Chapter 16
  -- we can't simply import them because Exp has been re-defined
  showExp :: Exp -> String
  showExp (Lit n)   = show n
  showExp (Add e f) = par (showExp e ++ " + " ++ showExp f)
  showExp (Mul e f) = par (showExp e ++ " * " ++ showExp f)
  
  par :: String -> String
  par s = "(" ++ s ++ ")"
  
  evalExp :: Exp -> Int
  evalExp (Lit n)   = n
  evalExp (Add e f) = evalExp e + evalExp f
  evalExp (Mul e f) = evalExp e * evalExp f
  
  s0 = showExp (read "Add (Lit 3) (Mul (Lit 7) (Lit 2))")
  
  i0 = evalExp (read "Add (Lit 3) (Mul (Lit 7) (Lit 2))")
  
  data Set = MkSet [Int]
  
  instance Eq Set where
    MkSet ms == MkSet ns = ms `subset` ns && ns `subset` ms
      where ms `subset` ns = and [ m `elem` ns | m <- ms ]
  
  b0 = MkSet [1,2] == MkSet [2,1]
  
  data Set' = MkSet' [Int] deriving Eq
  
  b0' = MkSet' [1,2] == MkSet' [2,1]
  
  -- Defining type classes
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Show, show)
  
  -- class Show a where
  --   show :: a -> String
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Eq, (==), (/=))
  
  -- class Eq a where
  --   (==) :: a -> a -> Bool
  --   (/=) :: a -> a -> Bool
  --   -- defaults
  --   x /= y = not (x == y)
  --   x == y = not (x /= y)
  
  -- The following type class definition and its instances for Bool and Maybe a are commented out because they
  -- are already in the Prelude.
  -- You can hide that definition and its instances to allow them to be re-defined by putting the following at the
  -- top of this module:
  -- import Prelude hiding (Ord, (<), (<=), (>), (>=), min, max)
  
  -- class Eq a => Ord a where
  --   (<)  :: a -> a -> Bool
  --   (<=) :: a -> a -> Bool
  --   (>)  :: a -> a -> Bool
  --   (>=) :: a -> a -> Bool
  --   min  :: a -> a -> a
  --   max  :: a -> a -> a
  --   -- defaults
  --   x < y         = x <= y && x /= y
  --   x > y         = y < x
  --   x >= y        = y <= x
  --   min x y
  --     | x <= y    = x
  --     | otherwise = y
  --   max x y
  --     | x <= y    = y
  --     | otherwise = x
  
  -- The following type definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Bool, True, False)
  
  -- data Bool = False | True
  --   deriving (Eq,Show,Ord)
  
  -- instance Ord Bool where
  --   False <= False = True
  --   False <= True  = True
  --   True  <= False = False
  --   True  <= True  = True
  
  -- The following type definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Maybe, Nothing, Just)
  
  -- data Maybe a = Nothing | Just a
  --   deriving (Eq,Show,Ord)
  
  -- instance Ord a => Ord (Maybe a) where
  --   Nothing <= Nothing = True
  --   Nothing <= Just x  = True
  --   Just x  <= Nothing = False
  --   Just x  <= Just y  = x <= y
  
  data Pair a b = Pair a b
    deriving (Eq,Show,Ord)
             
  -- The following type instance declaration is commented out because it duplicates the derived instance Ord (Pair a b).
  -- You can hide the derived instance by changing the definition of Pair a b to
  -- data Pair a b = Pair a b
  --   deriving (Eq,Show)
  
  -- instance (Ord a, Ord b) => Ord (Pair a b) where
  --   Pair x y <= Pair x' y' = x < x' || (x == x' && y <= y')
  
  b1 = Pair 1 35 <= Pair 2 7 -- 1st components determine result
  
  b2 = Pair 1 35 <= Pair 1 7 -- 1st components equal, compare 2nd components
  
  -- The following type instance declaration is commented out because it duplicates the derived instance Ord (Pair a b).
  -- You can hide the derived instance by changing the definition of Pair a b to
  -- data Pair a b = Pair a b
  --   deriving (Eq,Show)
  
  -- instance (Ord a, Ord b) => Ord (Pair a b) where
  --   Pair x y <= Pair x' y' = x < x' || (x == x' && y <= y')
  --   Pair x y < Pair x' y'  = x < x' || (x == x' && y < y')
  
  data List a = Nil
              | Cons a (List a)
    deriving (Eq,Show,Ord)
  
  -- The following type instance declaration is commented out because it duplicates the derived instance Ord (List a).
  -- You can hide the derived instance by changing the definition of List a to
  -- data List a = Nil
  --             | Cons a (List a)
  --   deriving (Eq,Show)
  
  -- instance Ord a => Ord (List a) where
  --   Nil       <= ys        = True
  --   Cons x xs <= Nil       = False
  --   Cons x xs <= Cons y ys = x < y || (x == y && xs <= ys)
  
  b3 = Cons 1 (Cons 35 Nil) <= Cons 2 (Cons 7 Nil)
  
  b4 = Cons 1 (Cons 35 Nil) <= Cons 1 (Cons 7 Nil)
  
  b5 = "ashen" <= "asia" -- 'a'=='a', 's'=='s', 'h'<='i'
  
  b6 = "ash" <= "as"     -- 'a'=='a', 's'=='s', "h" <= "" is False
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Enum, toEnum, fromEnum, succ, pred, enumFrom, enumFromTo, enumFromThen, enumFromThenTo)
  
  -- class Enum a where
  --   toEnum         :: Int -> a
  --   fromEnum       :: a -> Int
  --   succ, pred     :: a -> a
  --   enumFrom       :: a -> [a]            -- [x ..]
  --   enumFromTo     :: a -> a -> [a]       -- [x .. y]
  --   enumFromThen   :: a -> a -> [a]       -- [x, y ..]
  --   enumFromThenTo :: a -> a -> a -> [a]  -- [x, y .. z]
  -- 
  --   -- defaults
  --   succ x = toEnum (fromEnum x + 1)
  --   pred x = toEnum (fromEnum x - 1)
  --   enumFrom x
  --     = map toEnum [fromEnum x ..]
  --   enumFromTo x y
  --     = map toEnum [fromEnum x .. fromEnum y]
  --   enumFromThen x y
  --     = map toEnum [fromEnum x, fromEnum y ..]
  --   enumFromThenTo x y z
  --     = map toEnum [fromEnum x, fromEnum y .. fromEnum z]
  
  instance Enum Season where
    toEnum 0 = Winter
    toEnum 1 = Spring
    toEnum 2 = Summer
    toEnum 3 = Fall
    
    fromEnum Winter = 0
    fromEnum Spring = 1
    fromEnum Summer = 2
    fromEnum Fall   = 3
  
  data Season' = Winter' | Spring' | Summer' | Fall'
    deriving (Eq,Show,Enum)
  
  l0 = [Spring' .. Fall']
  
  l1 = [Fall', Summer' ..]
  
  -- Numeric type classes
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Num, (+), (-), (*), negate, abs, signum, fromInteger)
  
  -- class (Eq a, Show a) => Num a where  
  --   (+), (-), (*) :: a -> a -> a  
  --   negate        :: a -> a  
  --   abs, signum   :: a -> a  
  --   fromInteger   :: Integer -> a
  --   -- default
  --   negate x = fromInteger 0 - x
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Fractional, (/), recip, fromRational)
  
  -- class Num a => Fractional a where
  --   (/)          :: a -> a -> a
  --   recip        :: a -> a
  --   fromRational :: Rational -> a
  --   -- default
  --   recip x = 1/x
  
  -- The following type class definition is commented out because it is already in the Prelude.
  -- You can hide that definition to allow it to be re-defined by putting the following at the top of this module:
  -- import Prelude hiding (Floating, pi, exp, log, sqrt, (**), logBase, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh)
  
  -- class Fractional a => Floating a where
  --   pi                  :: a
  --   exp, log, sqrt      :: a -> a
  --   (**), logBase       :: a -> a -> a
  --   sin, cos, tan       :: a -> a
  --   asin, acos, atan    :: a -> a
  --   sinh, cosh, tanh    :: a -> a
  --   asinh, acosh, atanh :: a -> a
  --   
  --   -- defaults
  --   x ** y      = exp (log x * y)
  --   logBase x y = log y / log x
  --   sqrt x      = x ** 0.5
  --   tan  x      = sin  x / cos  x
  --   tanh x      = sinh x / cosh x
  
  -- Functors
  
  -- The following type class definition and its instances for [] and Maybe are commented out because they
  -- are already in the Prelude.
  -- You can hide that definition and its instances to allow them to be re-defined by putting the following at the
  -- top of this module:
  -- import Prelude hiding (Functor, fmap)
  
  -- class Functor t where  
  --   fmap :: (a -> b) -> t a -> t b
  
  l2 = map even [1,2,3,4,5]
  
  -- instance Functor [] where
  --   fmap = map
  
  -- instance Functor Maybe where
  --   fmap f (Just x) = Just (f x)
  --   fmap f Nothing  = Nothing
  
  squares :: Functor t => t Int -> t Int
  squares = fmap (^2)
  
  l3 = squares [2..10]
  
  l4 = squares (Just 3)
  
  class Bifunctor t where
    bimap :: (a -> b) -> (c -> d) -> t a c -> t b d
  
  instance Bifunctor Either where
    bimap f g (Left x)  = Left (f x)
    bimap f g (Right y) = Right (g y)
  
  instance Bifunctor Pair where
    bimap f g (Pair x y) = Pair (f x) (g y)
  
  -- Type classes are syntactic sugar
  
  elem' :: Eq a => a -> [a] -> Bool
  elem' x []     = False
  elem' x (y:ys) = x==y || elem' x ys
  
  elem'' :: (a -> a -> Bool) -> a -> [a] -> Bool
  elem'' eq x []     = False
  elem'' eq x (y:ys) = x `eq` y || elem'' eq x ys
  
  
  b7 = elem' 5 [1..10]
  
  b7' = elem'' eqInt 5 [1..10]
    where eqInt :: Int -> Int -> Bool
          eqInt = (==)
  
  eqList :: (a -> a -> Bool) -> [a] -> [a] -> Bool
  eqList eq [] []         = True
  eqList eq [] (y:ys)     = False
  eqList eq (x:xs) []     = False
  eqList eq (x:xs) (y:ys) = (x `eq` y) && (eqList eq xs ys)
  
  b8 = elem' "of" ["list","of","strings"]
  
  b8' = elem'' (eqList eqChar) "of" ["list","of","strings"]
    where eqChar :: Char -> Char -> Bool
          eqChar = (==)
  