-- Simple things are simple in Haskell.
-- 1. List-processing by pattern matching: Sorting based on quicksort.

quicksort [] = []
quicksort (p:xs) = (quicksort lesser) ++ [p] ++ (quicksort greater)
    where
        lesser = filter (< p) xs
        greater = filter (>= p) xs



-- Simple functions in Haskell



isEven :: Integer -> Bool
isEven n
  | n `mod` 2 == 0  = True
  | otherwise       = False


-- isEven2 :: Integer -> Bool
isEven2 :: Integral a => a -> Bool
isEven2 n =
   if n `mod` 2 == 0
   then True
   else False


isEven2b :: Integer -> Bool
{-
C style annotations
Bool isEvent (Integer) n = ...
-}
isEven2b n =
   if mod n 2 == 0
   then True
   else False


isEven3 :: Integer -> Bool
isEven3 n = let m = n `mod` 2
                p = m == 0
            in if p then True
               else False

isEven4 :: Integer -> Bool
isEven4 n = if p then True
            else False
            where
              m = n `mod` 2
              p = m == 0

-- Functions
---------------

add :: Num a => (a, a) -> a
add (x,y) = x + y

-- Numbers in Haskell are overloaded.

-- Demo.
{-
*Main> add (1,3)
4
*Main> add (1.5, 2.5)
4.0
-}


-- Curried style of defining the above function.
-- Means that arguments can be supplied one after other.
plus :: Num a => a -> a -> a
plus x y = x + y

-- Demo.
{-
*Main> plus 1 3
4
*Main> plus 1.5 2.5
4.0
-}

-- add and plus are NOT the same!

-- Let's examine plus in detail.

plus2 :: Num a => a -> a -> a
plus2 x = \y -> x + y
--        ^^^^^^^^^^^
--        Anonymous function (aka lambda expression)


plus3 :: Num a => a -> a -> a
plus3 = \x -> (\y -> x + y)

plus3With4 x y z = x + y + z

-- plus, plus2 and plus3 are effectively the same.
{-

    plus 1 3

stands for

   (plus 1) 3


That is, function application is left-associative.


Recall "method-chaining" is left-associative.
For example,

o1.m1().m2()  equivalent to (o1.m1()).m2()

The assumptions are:
 o1 is an object
 m1 is a method that yields another object
 on which we apply method m2



-}

-- Partial function application.
inc :: Int -> Int
inc = plus 1




-- Function application is left-associative.
-- Implies that unction types are right-associative.

plus4 :: Num a => a -> (a -> a)
plus4 x y = x + y


{-

  a -> a -> a

stands for

  a -> (a -> a)

-}

-- Operators versus functions

onePlusTwo = 1 `plus` 2

onePlusTwob = (+) 1 2

addOne = (1+)
-- addOne = (+) 1

-- Equivalent to addOne, cause + is commutative.
addOneb = (+1)
-- addOneb = \x -> x + 1
-- addOneb = \x -> (+) x 1

smallerOne = (<1)

greaterOne = (1<)

-- List Values:
-- []          Empty list
-- [1,2,3]     A list consisting of integers.

-- [1,2,3] is a short-hand for 1:2:3:[].
-- ":" is right-associative.
-- 1:2:3:[] means 1:(2:(3:[]))

-- The constructor ":" is pronounced "cons" in Haskell.


-- head, tail, null
-- head and tail are partial functions.
-- null is a total function.

-- Demo.
{-
*Main> head [1,2,3]
1
*Main> head []
*** Exception: Prelude.head: empty list
*Main> tail [1,2,3]
[2,3]
*Main> tail []
*** Exception: Prelude.tail: empty list
*Main> null [1,2,3]
False
*Main> null []
True
-}


-- Iteration via recursion.
-- Sum up all numbers in a list.
sumUp :: Num p => [p] -> p
sumUp xs
  | null xs   = 0
  | otherwise = head xs + sumUp (tail xs)


-- Demo.
{-
*Main> sumUp [1,2,3]
6

-}


sumUp2 :: Num p => [p] -> p
sumUp2 [] = 0
sumUp2 (x:xs) = x + sumUp2 xs

-- List patterns.
-- (x:xs) matches any non-empty list

myHead :: [a] -> a
myHead (x:_) = x
-- myhead (x:xs) = x
-- but there's no reference to xs (that is, we don't care about xs)
-- we use the "_" don't care symbol.

myTail :: [a] -> [a]
myTail (_:xs) = xs
-- myTail (x:xs) = xs

myNull :: [a] -> Bool
myNull [] = True
myNull (x:xs) = False

-- We can use don't care patterns.

myNullD :: [a] -> Bool
myNullD [] = True
myNullD (_:_) = False   -- "_" matches any value of that type

-- Yet another variant where "_" matches against a non-empty list.
-- Patterns are tried in textual order!
myNullD2 :: [a] -> Bool
myNullD2 [] = True
myNullD2 _ = False

-- Be careful. Textual order matters!
myNullD2b :: [a] -> Bool
myNullD2b _ = False
myNullD2b [] = True

{-
*Main> myNullD2 [1,2]
False
*Main> myNullD2 []
True
*Main> myNullD2b []
False
*Main> myNullD2b [1,2]
False
-}



-- The above definitions are syntactic sugar for case expressions.
myNull3 :: [a] -> Bool
myNull3 ys = case ys of
               [] -> False
               _ -> True

-- Some contrived example.
-- Patterns can be nested and are tried from top to bottom.
funny :: [a] -> Bool
funny []     = True
funny (x:[]) = True    -- can write [x] instead of (x:[])
funny (x:xs) = False   -- xs must be non-empty

{-
 In the third case, based on the textual order,
 we know that xs is non-empty !!!

-}


-- Compiler checks if pattern cases are redundant.
redundant []     = True
redundant (x:xs) = True
-- redundant [x]    = False      -- redundant, never applies

{-

Third pattern case [x] never applies, because

  [x] is a short-hand for (x:[])

  (x:[]) is a special case of the second case (x:xs)

-}

-- | Counting words.
-- Word = Sequence of characters not separated by white spaces (blanks).
count :: String -> Int
count [] = 0
count (c:cs)
  | c == ' ' = count $ skipBlanks cs
  | otherwise = 1 + count (skipWord cs)

-- | Generic skip function.
skip :: (Char -> Bool) -> String -> String
skip p [] = []
skip p (c:cs)
 | p c       = skip p cs
 | otherwise = c:cs

skipWord :: String -> String
skipWord   = skip (/= ' ')

skipBlanks :: String -> String
skipBlanks = skip (== ' ')


{-
Equivalent to skip.
1. Uses case expressions.
2. If-then-else.
-}

skip2 :: (Char -> Bool) -> String -> String
skip2 p s =
 case s of
   [] -> []
   (c:cs) -> if p c
             then skip2 p cs
             else c:cs

myMap f [] = []
myMap f (x:xs) = f x : myMap f xs

test1 = myMap (\(id,name,mark) -> (id,name,mark+1))    [(4544, "John", 50), (353, "Mary", 34)]

myMap2 f xs =
    case xs of
      [] -> []
      (y:ys) -> (f y) : ((myMap2 f) ys)


myFilter :: (a -> Bool) -> [a] -> [a]
myFilter p [] = []
myFilter p (x:xs) =
    if p x
    then x : myFilter p xs
    else myFilter p xs

test2 = myFilter (\(id,name,mark) -> mark >= 40)    [(4544, "John", 50), (353, "Mary", 34)]


test3 xs = map (+1) (filter (>0) xs)
test3b xs = map (+1) $ filter (>0) xs

test4 xs = [ x + 1 | x <- xs, x > 0 ]
--          ^^^^^    ^^^^^^   ^^^^^
--         mapper    iterator  filter

test5 xs = filter (>0) (map (+1) xs)

test5b xs = [ y | y <- [ x + 1| x <- xs ], y > 0]
--                     ^^^^^^^^^^^^^^^^^
--                     (map (+1) xs)
--           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
--            filter (>0) (...)

myAny :: (a -> Bool) -> [a] -> Bool
myAny p [] = False
myAny p (x:xs)
  | p x       = True
  | otherwise = myAny p xs

myAny2 p = or . map p

-- database exercise

type Student = (String, Int, [Int])
type DB = [Student]

incons1 = [("Jack", 111, [141, 252, 141])]
incons2 = [("Jane", 112, [141, 252]), ("JaneB", 112, [141, 252])]

-- task: check that database is consistent
-- Hint: reduces to checking that there are no duplicate entries in a list

-- Shall yield True if there are no duplicates
-- The type class constraint "Eq a" states that we can only check
-- for elements if they support equality.
duplicates :: Eq a => [a] -> Bool
duplicates [] = True
duplicates [x] = True
duplicates [x,y] = x /= y
duplicates (x:xs)
  | elem x xs = False
  | otherwise = duplicates xs


check1 db = duplicates (map (\(name,id,cs) -> id) db)

check2 db = and [ duplicates cs | (_,_,cs) <-db ]


check db = check1 db && check2 db

-- Type annotation must be provided.
-- Otherwise, Haskell will assign the type Integer instead of Int to numbers.
db2 :: DB
db2 = [("Jane", 112, [141, 252]), ("JaneB", 113, [140, 253])]

query1 :: DB -> Int -> [Int]
query1 [] _ = []
-- query1 ((name,id,cs):db) id = cs
-- Not allowed. Pattern variables always must be distinct.
query1 ((name,id,cs):db) id2
   | id == id2   = cs
   | otherwise = query1 db id2

-- More examples, see lecture notes


-- Representing students
-- ID, Name, List of courses taken
data Student = MkStudent Int String [Int]

-- Uncurried version
data Student2 = MkStudent2 (Int, String, [Int])


db1 :: [Student]
db1 = [MkStudent 1233 "John" [141,252],
       MkStudent 1143 "Jane" [252, 473]]

db2 :: [Student2]
db2 = [MkStudent2 (1233, "John", [141,252]),
       MkStudent2 (1143, "Jane", [252, 473])]


-- Extracting the ID for each student.
-- Several variants.
getAllIDs =
 map (\(MkStudent id n cs) -> id) db1

getAllIDs_b =
 map (\(MkStudent id _ _) -> id) db1


getAllIDs2 =
 map (\(MkStudent2 (id, n, cs)) -> id) db2


getAllIDs2_b =
 map (\s -> case s of
              (MkStudent2 (id, n, cs)) -> id
     ) db2

getAllIDs2_c =
 map (\s -> case s of
              MkStudent2 args -> case args of
                                       (id, _, _) -> id
     ) db2

-- Define your own list data type
--------------------------------------

data List a = Null | Cons a (List a)

mFilter :: (a -> Bool) -> List a -> List a
mFilter p Null = Null
mFilter p (Cons x xs)
   | p x       = Cons x (mFilter p xs)
   | otherwise = mFilter p xs

-- some list examples

-- [1,2,3]
list1 :: List Int
list1 = Cons 1 (Cons 2 (Cons 3 Null))


coerceTo :: List a -> [a]
coerceTo Null = []
coerceTo (Cons x xs) = (:) x (coerceTo xs)

coerceFrom :: [a] -> List a
coerceFrom [] = Null
coerceFrom (x:xs) = Cons x (coerceFrom xs)


mMap :: (a -> b) -> List a -> List b
mMap f xs = coerceFrom  (map f (coerceTo xs))

mFilter2 :: (a -> Bool) -> List a -> List a
mFilter2 p xs = coerceFrom (filter p (coerceTo xs))


-- Regular expressions
---------------------------


-- Data type to represent regular expressions.
data R = Phi            -- the empty language
       | Epsilon        -- the empty string
       | Sym Char       -- some alphabet symbol
       | Alt R R        -- alternatives
       | Conc R R       -- concatenation
       | Star R         -- zero or more iterations


-- (0 | 1) . (0 | 1)*
one = Sym '1'
zero = Sym '0'

-- (0 | 1)
oneOrZero = Alt zero one

ex_r1_b = Alt (Sym '0') (Sym '1')

ex = Conc (Alt zero one) (Star (Alt zero one))

ex_b = Conc oneOrZero (Star oneOrZero)

ex_c = Star oneOrZero

-- Task: Check if the expression is nullable.
-- Def: A expression is nullable, if the language
-- described by the expression contains the empty string.


-- Yield True if epsilon is part of the language, otherwise, we find False.
nullable :: R -> Bool
nullable Phi = False
nullable Epsilon = True
nullable Sym{} = False
-- spelled out as the following.
-- nullable (Sym _) = False
nullable (Alt r s) = nullable r || nullable s
nullable (Conc r s) = nullable r && nullable s
nullable Star{} = True


deriv :: Char -> R -> R
deriv _ Epsilon = Phi
deriv _ Phi = Phi
deriv x (Sym y)
  | x == y    = Epsilon
  | otherwise = Phi
deriv x (Alt r s) = Alt (deriv x r) (deriv x s)
deriv x (Conc r s)
  | nullable r = Alt (Conc (deriv x r) s) (deriv x s)
  | otherwise =  Conc (deriv x r) s
deriv x (Star r) = Conc (deriv x r) (Star r)

-- Task: Check if a string xs is in the language described by some
--       expression r?
membership :: String -> R -> Bool
membership xs r =
          go r xs
             where
               go r [] = nullable r
               go r (x:xs) = go (deriv x r) xs



a = Sym 'a'
b = Sym 'b'

r1 = Star a

r2 = Star (Alt a b)

-- More examples, see lecture notes

-- Recall students

data Student = MkStudent Int String [Int]

db1 = [MkStudent 1233 "John" [141,252],
       MkStudent 1143 "Jane" [252, 473]]

-- Filter all students taking a particular course
query1 courseNo =
  filter (\(MkStudent _ _ cs) -> elem courseNo cs) db1

{-

Printing a value in Haskell:
1. Assumes there's an instance of the "show" function
2. The "show" function can be overloaded

3. The "show " function belongs to the "Show" type class.

4. We usually refer to "show" as a method.

-}


instance Show Student where
   show (MkStudent id n cs) =
       n ++ " has student ID " ++ show id


-- Looking for a specific student

query2 = elem (MkStudent 1143 "Jane" [252, 473]) db1

{-

Comparing values in Haskell via "==".

1. "==" is pre-defined for primitive types

2. "==" is an overloaded operator

3. "==" can be overloaded

-}


{-
-- Via "deriving Eq" attached to the data type definition,
-- we generate 'standard' instances automatically.

-}
instance Eq Student where
   (==) (MkStudent id1 n1 cs1)
        (MkStudent id2 n2 cs2) = id1 == id2 &&
                                 n1 == n2 &&
                                 cs1 == cs2


-- Defining your own type class
--------------------------------------

{-

1. A type class describes a collection of methods.

2. Type classes are parameterized by types.

3. The type parameter represents the "overloaded" type.

-}


class MyEqShow a where
    myEq :: a -> a -> Bool
    myShow :: a -> String

myElem :: MyEqShow a => a -> [a] -> Bool
myElem x [] = False
myElem x (y:ys)
  | myEq x y   = True
  | otherwise  = myElem x ys

instance MyEqShow Student where -- (S1)
  myEq (MkStudent id1 n1 cs1)
       (MkStudent id2 n2 cs2) = id1 == id2 &&
                                n1 == n2 &&
                                cs1 == cs2
  myShow (MkStudent id n cs) =
       n ++ " has student ID " ++ show id

query3 = myElem (MkStudent 1143 "Jane" [252, 473]) db1

myPrint = putStrLn (myShow db1)
{-

Requires an instance MyEqShow [Student]

We can build such an instance as follows.

We use S1 applied to S2 to build

MyEqShow [Student]


-}


instance MyEqShow a => MyEqShow [a] where -- (S2)
    myEq [] [] = True
    myEq (x:xs) (y:ys) = myEq x y && myEq xs ys
    myEq _ _ = False    -- or shorter
{-
    myEq [] (x:xs) = False
    myEq (x:xs) [] = False
-}

    myShow [] = "[]"
    myShow (x:xs) =
         "[" ++
         myShow x ++
         (if length xs == 0
          then "]"
          else myShow xs)

data List a = Null | Cons a (List a) deriving Show

{-

Requires an instance of equality, indicated as "Eq t",
because we compare list values, see "x == y".

-}
member :: Eq t => t -> List t -> Bool
member x Null = False
member x (Cons y ys)
    | x == y    = True
    | otherwise = member x ys


{-

Type classes are not types.

You can view a type class as a type predicate.

For example, "Eq a" states that there's an instance of the "Eq" type class for "a".

Question: How can the compiler "run" (compile) the above code, say the "member" function.

Consider the following expression:

member False (Cons True (Cons False Null))


The compiler does quite a few interesting things.

- Check that there is an instance for Eq Bool because
  we use "member :: Eq t => t -> List t -> Bool" where
  "t" equals Bool.

- In a naive compilation scheme, we could carry out types at run-time.

- Then, we perform a look-up of the type of "x" and "y" in the context
  " x == y".

- "x" and "y" are of type Bool. Hence, we lookup the instance of "=="
  for Bool.

Good news. Haskell employs a much smarter compilation scheme for type classes.

Type classes are predicates.
We need a proof for these predicates.
Proofs are specific instances.

For example, the proof for "Eq Bool" is the concrete implementation to decide
equality among Booleans.

For example, the proof for "Eq Funny" is the below concrete implementation.
See the comment FUNNY-EQ.

Short summary: Proofs are programs.

In our case, proofs are "dictionaries".

Insight:
- The compiler needs to insert proofs when type checking the program.

Consider another example

member B (Cons A (Cons A Null))

We need to provide a proof for Eq Funny.

But means we need to insert a dictionary.

-}

data Funny = A | B deriving Show

instance Eq Funny where    -- FUNNY-EQ
     (==) = primEqFunny
{-
    (==) A A = True
    (==) B B = True
    (==) _ _ = False
-}

primEqFunny :: Funny -> Funny -> Bool
primEqFunny A A = True
primEqFunny B B = True
primEqFunny _ _ = False

-- This what the compiler does.

data DictEq a = MkDictEq (a -> a -> Bool)

-- Turn type classes into dictionaries.
-- Replace method calls via a lookup of the
-- method in the dictionary.

memberC :: DictEq t -> t -> List t -> Bool
memberC _ x Null = False
memberC (MkDictEq eq) x (Cons y ys)
    | eq x y    = True
    | otherwise = memberC (MkDictEq eq) x ys

-- How to translate the following?

exFunny = member B (Cons A (Cons A Null))
-- Compilers infers that
-- we require here Eq Funny.

-- The translation yields the following.

exFunnyC = memberC (MkDictEq primEqFunny) B (Cons A (Cons A Null))

--  (MkDictEq primEqFunny) is a proof for Eq Funny

-- The above translation scheme is called "The dictionary-passing translation scheme".