{-  Exploring Languages with Interpreters and Functional Programming
    Chapter 22: Overloading and Type Classes 
    Copyright (C) 2018, H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2017-Spr:   Adapted from previous work for chapter of textbook
2018-07-21: Updated for compatibility with Chapter 22

-}

module TypeClassMod
where

elemBool :: Bool -> [Bool] -> Bool
elemBool x []     = False
elemBool x (y:ys) = eqBool x y || elemBool x ys

eqBool :: Bool -> Bool -> Bool
eqBool True  False = False
eqBool False True  = False
eqBool _     _     = True

elemGen :: (a -> a -> Bool) -> a -> [a] -> Bool
elemGen eqFun x []      = False
elemGen eqFun x (y:ys)  = eqFun x y || elemGen eqFun x ys

elemBool' :: Bool -> [Bool] -> Bool
elemBool' = elemGen eqBool

-- class Eq a where
--    (===) :: a -> a -> Bool

class Eq' a where
    (===), (/==) :: a -> a -> Bool
    -- Minimal complete definition: (===) or (/==)
    x /== y  =  not (x === y)
    x === y  =  not (x /== y)

instance Eq' Bool where
    True  === True  = True
    False === False = True
    _     === _     = False

instance Eq' Int where 
    (===) = primEqInt

instance Eq' Char where 
    (===) = primEqChar

instance Eq' a => Eq' [a] where
    []     === []      =  True
    (x:xs) === (y:ys)  =  x === y && xs === ys
    _      === _       =  False

class Visible a where
    toString :: a -> String
    size     :: a -> Integer

instance Visible Char where
    toString ch  = [ch]
    size _       = 1

instance Visible Bool where
    toString True  = "True"
    toString False = "False"
    size _         = 1

instance Visible a => Visible [a] where
    toString = concat . map toString
    size     = foldr (+) 1 . map size

class Eq' a => Ord' a where
    (<<<), (<==), (>>>), (>==) :: a -> a -> Bool
    max, min     :: a -> a -> a
    -- Minimal complete definition: (<<<) or (>)
    x <== y             = x <<< y || x === y
    x <<< y             = y >>> x
    x >== y             = x >>> y || x === y
    x >>> y             = y <<< x
    max x y   | x >== y = x
      | otherwise       = y
    min x y   | x <== y = x
      | otherwise       = y

isort' :: Ord' a => [a] -> [a]
isort' []     = []
isort' (x:xs) = insert' x (isort' xs)

insert' :: Ord' a => a -> [a] -> [a]
insert' x []    = [x]
insert' x (y:ys)
    | x <== y   = x:y:ys
    | otherwise = y : insert' x ys

vSort :: (Ord' a,Visible a) => [a] -> String
vSort = toString . isort' 

vLookupFirst :: (Eq' a,Visible b) => [(a,b)] -> a -> String
vLookupFirst xs x = toString (lookupFirst xs x)

lookupFirst :: Eq' a => [ (a,b) ] -> a -> [b]
lookupFirst ws x = [ z | (y,z) <- ws , y===x ]

instance (Eq' a,Eq' b) => Eq' (a,b) where
    (x,y) === (z,w) =  x === z && y === w

class (Ord' a,Visible a) => OrdVis a

-- vSort :: OrdVis a => [a] -> String