{-#LANGUAGE TypeSynonymInstances #-}

member [] y = False
member (x:xs) y = (x == y) || (member xs y)

sumOfSquares [] = 0
sumOfSquares (x:xs) = x*x + sumOfSquares xs

square :: Num a => a -> a
square x = x * x

squares :: (Num t, Num t1, Num t2) => (t, t1, t2) -> (t, t1, t2)
squares (x,y,z) = (square x, square y, square z)



-- Haskell member function
mmember :: Eq a => [a] -> a -> Bool
mmember [] y = False
mmember (x:xs) y = x == y || (mmember xs y)

-- Haskell member function, passing equality explicity
member' :: (a->a->Bool) -> [a] -> a -> Bool
member' eq [] y = False
member' eq (x:xs) y = (eq x y) || (member' eq xs y)

-- Sorting function with explicit comparison
qsort:: (a -> a -> Bool) -> [a] -> [a]
qsort comp [] = []
qsort comp (x:xs) = qsort comp (filter (comp x) xs) 
		    ++ [x] ++ 
                    qsort comp (filter (not.comp x) xs)

myCmp x y = x > y
sortedList = qsort myCmp [2,4,2,7,2,3]

-- Haskell numeric function using overloading
parabola :: Num a => a -> a
parabola x = (x * x) + x 

-- Haskell numeric function, passing + and * explicity
parabola' :: ((a->a->a), (a->a->a)) -> a -> a
-- parabola' (plus,times) x = (x `times` x) `plus` x
parabola' (plus, times) x = plus (times x x) x

-- Haskell numeric function, Dictionary translation

-- Type of dictionary: What a type class declaration specifies.
data PlusTimesDict a = MkPlusTimesDict (a->a->a) (a->a->a)
-- Accessor functions
get_plus :: PlusTimesDict a -> (a->a->a)
get_plus (MkPlusTimesDict p t) = p

get_times :: PlusTimesDict a -> (a->a->a)
get_times (MkPlusTimesDict p t) = t

intPlus :: Int -> Int -> Int
intPlus = (+)

intTimes :: Int -> Int -> Int
intTimes = (*)

floatPlus :: Float -> Float -> Float
floatPlus = (+)

floatTimes :: Float -> Float -> Float
floatTimes = (*)

-- Dictionary construction: what a type class instance specifies.
intDict = MkPlusTimesDict intPlus intTimes
floatDict = MkPlusTimesDict floatPlus floatTimes

-- Function with explicit dictionary
parabola''' :: PlusTimesDict a -> a -> a
parabola''' dict x = let plus = get_plus dict
                         times = get_times dict
                     in plus (times x x) x

-- Or more concisely...
parabola'' :: PlusTimesDict a -> a -> a
parabola'' dict x = get_plus dict (get_times dict x x) x

y = parabola'' intDict 10
z = parabola'' floatDict 3.14


-- Only types that have a corresponding dictionary of type
-- PlusTimesDict can be passed to the parabola'' function.

-- Type classes provide a way of managing this plumbing automatically.
-- Type class causes compiler to generate dictionary type.
-- Each instance declaration causes compiler to generate a value of the dictionary,
-- containing the operations for the type being instantiated.
-- Each function that has a qualified type will be rewritten by the compiler
-- to take an extra dictionary parameter and to use the dictionary to look up the 
-- appropriate code for each "overloaded" function.  For example, 
--   parabola :: PlusTimesDict a => a -> a
--   parabola x = x * x + x
-- will lead to parabola'' definition.


-- User defined types can be made instances of existing type classes.
-- For example, we can declare a dataype Cpx to represent complex numbers,
-- and make that type an instance of the Num class.

-- A complex number over type a is a pair of a's.
-- Intuitively, a will be some kind of numeric type.
data Cpx a = Cpx a a
   deriving (Eq, Show)

-- If type a is an instance of Num, then so is Cpx a.
-- The instance declaration for Cpx a defines the necessary
-- operations of the Num class in terms of the existing 
-- operations on a's.  The fact that a is an instance of Num
-- guarantees that a will have the necessary operations defined.
instance Num a => Num (Cpx a) where
  (Cpx r1 i1) + (Cpx r2 i2) = Cpx (r1+r2) (i1+i2)
  (Cpx r1 i1) * (Cpx r2 i2) = Cpx (r1*r2) (i1*i2)
  (Cpx r1 i1) - (Cpx r2 i2) = Cpx (r1-r2) (i1-i2)
  negate (Cpx r i) = Cpx (negate r) (negate i)
  abs (Cpx r i)    = Cpx (abs r) (abs i)
  signum (Cpx r i) = Cpx (signum r) (signum i)
  fromInteger n = Cpx (fromInteger n) 0

-- Given that we have Num (Cpx a), we can use all the
-- operations defined in the Num class on our complex numbers,
-- including being able to have literals have type Cpx a
c1 = 1 :: Cpx Int
c2 = 2 :: Cpx Int
c3 = Cpx 1 3
c4 = c1 + c3
c5 = c1 * c2


-- We can also apply user-defined functions for the Num
-- class on our complex numbers:
c6 = parabola c4
i1 = parabola 3 

-- It is convenient to have the compiler automatically
-- generate instance declarations for some type classes.
-- In particular, the Read, Show, Eq, and Ord classes.
-- The "deriving" clause annotating the Color data type
-- declaration instructs the compiler to generate functions
-- for converting from a string (Read), converting to a 
-- string (Show), comparing for equality (Eq), and comparing
-- for order (Ord).  
data Color = Red | Green | Blue
     deriving (Read, Show, Eq, Ord)

s1 = show Red
c = (read "Red" :: Color )

p1 = (2,3)
p2 = (5,1)

-- Newtype declarations allow us to introduce a new type
-- that is implemented in terms of existing types but is
-- not considered equal to the underlying implementation
-- by the type checker.  This facilty allows us to specify
-- different implementations for overloaded functions than
-- any existing implementations for the underlying types.
-- The deriving clause below instructs the compiler to
-- reuse the underlying defintions for Eq, Ord, and Show.
newtype UniqueID = UniqueID (Int,Int)
   deriving (Eq, Ord, Show)

-- The class Foo specifies the existence of an operator '@@@@' 
-- that takes two 'a' values and returns a boolean.  
class Foo a where
  (@@@@) :: a -> a -> Bool

-- Make Int an instance of class Foo by defining the (@@@@)
-- to be the equality function on Ints.
instance Foo Int where
  i @@@@ j = i == j

-- Make Char an instance of class Foo by defining the (@@@@)
-- to be the equality function on Chars.
instance Foo Char where
  i @@@@ j = i == j

-- If a is a Foo and if b is a Foo, then make the pair (a,b)
-- an instance of Foo by defining the (@@@@) operator for
-- pairs in terms of the @@@@ operators for a and for b.
instance (Foo a, Foo b) => Foo (a,b) where
  (u,v) @@@@ (x,y) =  (u @@@@ x) && (v @@@@ y)


-- If a is a Foo, then make the list [a] an instance of Foo
-- by defining the (@@@@) operator over lists in terms
-- of the @@@@ operator for a.
instance Foo a => Foo [a] where
  [] @@@@ [] = True
  (x:xs) @@@@ (y:ys) = x @@@@ y && xs @@@@ ys

-- Make String an instance of class Foo by defining the (@@@@)
-- to be the equality function on String.
instance Foo String where
  s @@@@ s2 = s == s2
-- Because String is defined in Haskell to be [Char],
-- the compiler has two different possible implementations
-- of (@@@@) to chose from for Strings.  The one defined below
-- directly for Strings and one that can be built from the
-- instance for Char and for List.  Normally, in this situation
-- the compiler will complain about an ambiguous instance. 
-- The pragma
--     {-#LANGUAGE TypeSynonymInstances #-}
-- at the top of this file tells the compiler not to complain
-- about this issue, and to take the more specific instance,
-- which in this case for String is Foo String.


-- This example is intended to illustrate type inference
-- including type classes.  
myexample :: (Ord a) => a -> [a] -> Bool
myexample z xs = 
   case xs of
     []     -> False
     (y:ys) -> y > z || (y==z && ys ==[z])

-- We can define overloaded functions in terms of 
-- other overloaded functions.  For example,
-- both member and square are both overloaded functions:
--   member :: (Eq t) => [t] -> t -> Bool
--   square :: (Num a) => a -> a
-- and they are used to define memsq, another overloaded function.
memsq :: (Eq a, Num a) => [a] -> a -> Bool
memsq xs x = member xs (square x)

-- There are many different data structures for which it is useful
-- to define a map function.  
-- The mapList function maps a function over a list.
mapList :: (a -> b) -> [a] -> [b]
mapList f [] = []
mapList f (x:xs) = f x : mapList f xs

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

-- The mapTree function maps a function over a tree.
mapTree :: (a -> b) -> (Tree a -> Tree b)
mapTree f (Leaf x) = Leaf (f x)
mapTree f (Node(l,r)) = Node (mapTree f l, mapTree f r)

t1 = Node(Node(Leaf 3, Leaf 4), Leaf 5)

data Opt a = Some a | None
 deriving Show

-- The mapOpt function maps a function over an option.
mapOpt :: (a -> b) -> (Opt a -> Opt b)
mapOpt f None = None
mapOpt f (Some x) = Some (f x)

o1 = Some 10

-- The HasMap type class takes a *type constructor*
-- as an argument, not a type.  Ie, 'f' is not a type itself,
-- rather 'f' applied to a type 'a' is a type.  
-- It is intended to be instantiated with [], Tree, Opt,
-- or similar type constructors.  (Note [] is the notation
-- for the list type constructor.) 

class HasMap f where
  map' :: (a->b) ->(f a -> f b)

-- Make the list type constructor an instance of the HasMap type constructor
-- class. the implementation of map' is just the same as the implementation
-- of the mapList function.
instance HasMap [] where
  map' f [] = []
  map' f (x:xs) = f x : map' f xs

-- Make the Tree type constructor an instance of the HasMap type constructor
-- class. the implementation of map' is just the same as the implementation
-- of the mapTree function.
instance HasMap Tree where
  map' f (Leaf x) = Leaf (f x)
  map' f (Node(t1,t2)) = Node(map' f t1, map' f t2)

-- Make the Opt type constructor an instance of the HasMap type constructor
-- class. the implementation of map' is just the same as the implementation
-- of the mapOpt function.
instance HasMap Opt where
  map' f (Some s) = Some (f s)
  map' f None = None


-- Overloaded uses of the map' function, applying the successor function
-- to lists, trees, and options.
r1 = map' (\x->x+1) [1,2,3]
r2 = map' (\x->x+1) (Node(Leaf 1, Leaf 2))
r3 = map' (\x->x+1) (Some 1)