import Data.IORef
import Test.QuickCheck


-- 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


-- Demo.
{-
*Main> quicksort [1,4,5,17,11,2]
[1,2,4,5,11,17]
-}


-- 2. Expressive type system. Implicitely typed.
-- Demo.
{-
*Main> :t quicksort
quicksort :: Ord a => [a] -> [a]

"Ord a" is a type constraint.
Elements of type "a" must come with an ordering relation (instance "Ord").

-}


-- 3. Define your own data types. Here a simple form of an enumerated type.

data Beer = Erdinger | Warsteiner deriving Show


-- 4. Extend definitions of overloaded methods.
-- Again, definition by pattern matching.

-- "deriving Show" automatically builds an instance of the overloaded "show" method.

instance Eq Beer where
    (==) Erdinger Erdinger = True
    (==) Warsteiner Warsteiner = True
    (==) _ _ = False

instance Ord Beer where
    (<=) Erdinger Warsteiner = True
    (<=) Erdinger Erdinger = True
    (<=) _ _ = False


-- Demo.
{-
*Main> quicksort [Erdinger, Warsteiner, Erdinger]
[Erdinger,Erdinger,Warsteiner]
-}

-- 5. Cool concepts that allow for powerful tools: Automated testing via QuickCheck.

-- Property: quicksort yields a list with the same number of elements.
property1 :: Ord a => [a] -> Bool
property1 xs = length xs == length (quicksort xs)


-- Property: quicksort yields a list with the same number of elements.
property2 :: Ord a => [a] -> Bool
property2 xs = hasElem xs (quicksort xs) && hasElem (quicksort xs) xs
    where hasElem xs [] = True
          hasElem xs (y:ys)
            | elem y xs = hasElem xs ys
            | otherwise = False

-- Demo.
{-
*Main> quickCheck property1
+++ OK, passed 100 tests.
*Main> quickCheck property2
+++ OK, passed 100 tests.
-}


-- 6. Some things are not as simple as in C/Java.

-- I/O (input/output), in-place updates, ...

-- Haskell is by default a pure language.
-- If we use side-effects, we need to switch to a monadic style of programming.

main = do {
         print "What is your name?";
         name <- getLine;
         print ("Hello " ++ name ++ "!");
         print "Your age?";
         age <- getLine;
         x <- newIORef (read age :: Int);
         v <- readIORef x;
         writeIORef x (v-5);
         v <- readIORef x;
         print ("Your actual age: " ++ show v) }

-- 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
-}


{-

Let's compare the Haskell to the C version.

int add(int x, int y) { return x+y; }

==> get rid of the types

add(x, y) { return x+y; }

==> get rid of commands

add(x, y) = x+y

-}

-- 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 function 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

-}


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

myHead :: [a] -> a
myHead (x:_) = x

myTail :: [a] -> [a]
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


-- 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


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

-- More on lists.

-- Extracting the last element from a list.
lastElem (x:[]) = x                -- (x:[]) can be written as [x]
lastElem (x:xs) = lastElem xs

{-

Let's some calculations by hand.

    lastElem [1,2,3]
=>  lastElem (1:2:3:[])

         Recall that : ("cons") is right associative.
         This means,

              (1:2:3)  is a short-hand for (1:(2:(3:[])))

=>  lastElem (1:(2:(3:[])))

      We need to check for any matching pattern in
      lastElem's function definition.

       Does (1:(2:(3:[]))) match (x:[])? No!

       Let's check the next pattern case.

       Does (1:(2:(3:[]))) match (x:xs)? Yes!
        x is bound to 1
        xs is bound to (2:(3:[])) which equals [2,3]

=> lastElem (2:(3:[]))

    we take some short-cuts from here on

=> lastElem (3:[])

=> 3


-}

-- Appending two lists.
append :: [a] -> [a] -> [a]
append [] xs = xs
append (x:xs) ys = x : (append xs ys)

{-

Can we use ++ in a pattern?

funny :: [a] -> [a]
funny (xs ++ ys) = xs

Will this work? No!
Pattern matching becomes ambiguous.

Consider the list [1,2].

Let's try and match [1,2] against (xs ++ ys).

First, there's a match but there are a bunch of
possible matches.

Matching [1,2] against (xs ++ ys) could
yield the following results

 1.  xs = [] and ys = [1,2]
 2.  xs = [1] and ys = [2]
 3.  xs = [1,2] and ys = []

FYI, in the context of regular expressions
we find disambiguation strategies like POSIX, Greedy, ..
But in Haskell, we simply disallow this kind of pattern.

-}


-- map, filter, ...
-- details see lecture notes

map2 :: (a -> b) -> [a] -> [b]
map2 f [] = []
map2 f (x:xs) = (f x) : ((map2 f) xs)
--
-- Function application binds tigher than ":".
-- Hence, we can write
-- map2 f (x:xs) = f x : (map2 f) xs
--
-- Function application is right-associative.
-- Hence, we can write
-- map2 f (x:xs) = f x : map2 f xs

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

{-

List comprehensions translate to map and filter.

[ f x | x <- xs, p x]

   =

 map f (filter p)

-}


-- Flattening a list where we use nested generators.
flatten :: [[a]] -> [a]
flatten xss = [ x | xs <- xss, x <- xs ]


-- Code reuse in Haskell.
-- There's no performance penalty thanks to lazy evalation.

or2 [] = False
or2 (True:_) = True
or2 (False:xs) = or2 xs

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

any3 :: (a -> Bool) -> [a] -> Bool
any3 p = or2 . (map2 p)


-- "fold":
-- 1. Apply a binary operator to a bunch of arguments.
-- 2. Assumes some initial value in case there are zero arguments.
--
-- mfoldl f z [x1,...,xn] => f (... (f z x1) ...) xn
--
mfoldl :: (t1 -> t2 -> t1) -> t1 -> [t2] -> t1
mfoldl f z []     = z
mfoldl f z (x:xs) = mfoldl f (f z x) xs

{-

:t foldl
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b

More generic version.
Lists are "foldable".

-}

-- Example:
-- Managing a store of products where we use
-- a mix of map/filter/fold and list comprehensions.
-----------------------------------------------------


sumUp :: Num p => [p] -> p
sumUp xs
  | null xs   = 0
  | otherwise = head xs + sumUp (tail xs)

sumUpFold :: Num p => [p] -> p
sumUpFold xs = foldl (+) 0 xs


type Name = String
type Quantity = Int
type Price = Float
type Product = (Name, Quantity, Price)

-- Sum up the price of all products.

sumPrice :: [Product] -> Float
sumPrice ps =  sumUp (map (\(_,_,p) -> p) ps)

-- Variant where we include the quantity as well.
-- sumPriceIncludingQt ps = sumUp (map (\(_,q,p) -> q * p) ps)

sumPrice2 :: [Product] -> Float
sumPrice2 ps = sumUp [ p | (_,_,p) <- ps ]

sumPrice3 :: [Product] -> Float
sumPrice3 ps = foldl (\acc -> \(_,_,p) -> acc+p) 0 ps

-- Update the price of a product.

updatePrice :: (Name,Price) -> [Product] -> [Product]
updatePrice (n,p) ps =
    map (\(n2,q,p2) -> if n == n2
                       then (n,q,p)
                       else (n2,q,p2)) ps

updatePrice2 :: (Name,Price) -> [Product] -> [Product]
updatePrice2 (n,p) ps = [ up pr | pr <- ps]
                    where
                      up (n2,q,p2)
                        | n == n2    = (n,q,p)
                        | otherwise =  (n2,q,p2)



nub :: Eq a => [a] -> [a]
nub [] = []
nub (x:xs)
  | elem x xs = nub xs
  | otherwise = x : nub xs

-- Check if there are products with duplicate names.
dupP :: [Product] -> Bool
dupP ps = let ns = map (\(n,_,_) -> n) ps
          in ns /= nub ns

-- A student is represented by her name, student id and
-- a list of the courses the student is taking


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



-- TASK 0
{-
Databases must be consistent.
We say the database is consistent if there're no multiple entries
of students, and no multiple entries of courses per students
 For example, the below databases are *inconsistent*
-}


-- Type annotations are not strictly necessary in Haskell.
-- However, without the annotation, Haskell will infer
-- the type [(String, Integer, [Integer])] and then we get a type conflict
-- when applying the "valid" function.
incons1 :: DB
incons1 = [("Jack", 111, [141, 252, 141])]

incons2 :: DB
incons2 = [("Jane", 112, [141, 252]), ("Jane", 112, [141, 252])]

-- What is the essential task we need to solve here?
-- There are no duplicates in a list.

------------------------------------
-- SOLUTION developped in class

-- Idea:
-- Iterate through the list.
-- For each element check that this element is not in the tail.

-- In Haskell, iteration here means, we look at the possible patterns of input.
checkDups :: Eq a => [a] -> Bool
checkDups [] = False
checkDups (x:xs)
  | elem x xs = True
  | otherwise = checkDups xs


checkValid db =
     (not (checkDups (map (\(_,studentID,_) -> studentID) db)))
     &&
     -- Yet need to do,
     -- for each student check that in her list of courses,
     -- there are no duplicates.
     (not (or (map (\(_,_,courses) -> checkDups courses) db)))


-- \(_,studentID,_) -> studentID
-- Lambda function to extract the student id.
-- In the argument, we use pattern matching.
-- The pattern (_,studentID,_) refers to any triple
-- where we make use of the don't care pattern "_".

checkValidVariant db =
     not $ checkDups $ map (\(_,studentID,_) -> studentID) db
-- We use "$" as a way to avoid putting the argument into "(...)".

-- End of SOLUTION
------------------------------------

db1 :: DB
db1 = [("Jae", 112, [141]), ("Jane", 112, [141, 252])]

db2 :: DB
db2 = [("Jane", 113, [141]), ("Jane", 112, [141, 252])]

{-
Your task is to implement the following function
which returns True if the database is valid (consistent),
otherwise the function returns False.
-}
valid :: DB -> Bool
valid db =   (not $ duplicates $ map (\(_,i,_) -> i) db)
          && (not $ or $ map (\(_,_,cs) -> duplicates cs) db)
    -- valid1 db && valid2 db

-- There're no multiple entries of students.
-- That means, student ids are distinct.
-- Algo:
--   1. Extract from each student its id.
--   2. Check that there are no duplicates.
--      To check for duplicates,
--        iterate through the list and check for each element x
--        that x won't appear elsewhere in the list.
--        That means, if we start with the front of the list,
--        x won't appear in the tail.
valid1 :: DB -> Bool
valid1 db = not $ duplicates $ map (\(_,i,_) -> i) db

-- No multiple entries of courses per students
-- valid2 :: DB -> Bool
valid2 db = not $ or $ map (\(_,_,cs) -> duplicates cs) db

duplicates :: Eq a => [a] -> Bool
duplicates [] = False
duplicates (x:xs)
  | elem x xs = True
  | otherwise = duplicates xs

-- EXTENSION TO TASK 0
{-
Extension: We strengthen the notion of consistency.
In addition, we require that there shall by no duplicate student id's.
For example,
-}

incons3 = [("Jane", 111, [141]), ("Jack", 111, [141, 252])]

-- Remark:
-- In our definition of equality among students,
-- we assume that their names do not matter,
-- we only consider their student ids.


-- FROM HERE ON, WE WILL ASSUME THAT ALL DATABASES ARE CONSISTENT !!!


-- TASK 1
{-
Given a database and a student id, we're looking for the list of
courses of this particular student.
-}
query1 :: DB -> Int -> [Int]
query1 = error "Your code"

----------------------
-- SOLUTION class

query1Attempt [] _  = []
query1Attempt ( (_ , id, cs) : dbs) id2 =
    if id == id2
    then cs
    else query1Attempt dbs id2

-- Pattern ( (_ , id, cs) : dbs)
-- refers to a list where we consider the first student (head) in that list,
-- id refers to the student's id and cs to the student's courses,
-- dbs refers to the remaining students.


query1Attempt2 db id2 =
     case (filter (\(_,id,_) -> id == id2) db) of
        [] -> []
        [(_,_,cs)] -> cs

-- "case" analysis
-- for example,
--   [(_,_,cs)] -> cs
-- applies if we find a value that is a singleton list (exactly one element)
-- as we are only interested in the list of courses,
-- we use some don't care pattern variables.
-- The arrow "->" here, separates the pattern from the expression.


-- End of SOLUTION
----------------------

-- TASK 2
{-
Given a database and a course, find all students
taking this course.
-}
query2 :: DB -> Int -> [String]
query2 = error "Your code"



-- TASK 3
{-
Given a database, sort the database (in non-decreasing order)
according to the name of students.
-}
sortDB :: DB -> DB
sortDB = error "Your code"

{-
Extension1:
Provide a function sortDB' which sorts the database according to the number of courses a student is taking

Extension2:
Provide a function sortDB'' which is parameterized in the actual comparing relation which determines the sorting order
For example:
 Given

cmpName :: Student -> Student -> Ordering
cmpName (n1, _, _) (n2, _, _) =
 if n1 < n2
 then LT
 else if n1 == n2
      then GT
      else EQ

Then you can define

 sortDB = sortDB'' cmpName

-}


-- TASK 4
{-
Given two databases, merge them to obtain one (consistent) database
 Example:

 merge [("Jane", 112, [141, 353])] [("Jane", 112, [141, 252])]
    => [("Jane", 112, [141, 252, 353])]

-}

merge :: DB -> DB -> DB
merge = error "Your code"

/*

C, Java, ... are impure (with side effects), command-oriented languages.

What are side effects?
Printing to the console, reading from the console, overwriting a value stored in a variable, ...

 */


#include <stdio.h>

int incAndSumUp(int xs[], int len) {
  int i, s;

  for(i=0; i<len; i++) {
    xs[i] = xs[i] + 1;
  }

  s = 0;
  for(i=0; i<len; i++) {
    s = s + xs[i];
  }

  return s;
}

void test() {
  int xs[3] = {1, 2, 4};

  printf("\n %d", incAndSumUp(xs,3));

  printf("\n %d", xs[0]);

}

int main() {
  test();
}

/*

C, Java, ... are impure (with side effects), command-oriented languages.

What are side effects?
Printing to the console, reading from the console, overwriting a value stored in a variable, ...

 */

// "State" is implicit in C.
// What is state?
// The current mapping of variables (memory locations) to values, ...

#include <stdio.h>

int incAndSumUp(int xs[], int len) {
  int i, s;

  // Before:
  // xs[0] = v_0, ..., xs[len-1] = v_len-1
  for(i=0; i<len; i++) {
    xs[i] = xs[i] + 1;
  }
  // After:
  // xs[0] = v_0+1, ..., xs[len-1] = v_len-1+1

  // Point to note:
  // Commands are state transformers!
  // Input is the current state and the output is the new state.

  s = 0;
  for(i=0; i<len; i++) {
    s = s + xs[i];
  }

  return s;
}

void test() {
  int xs[3] = {1, 2, 4};

  printf("\n %d", incAndSumUp(xs,3));

  printf("\n %d", xs[0]);

}

int main() {
  test();
}

import Data.IORef
import System.FilePath.Posix(takeBaseName)
import Data.List.Split (splitOn)



-- Haskell is a pure, expression-oriented language.
-- A pure function will always compute the same result for the same set of inputs (no side effects).

incAndSumUp xs = sum (map (+1) xs)


{-

*Main> incAndSumUp [1,2,4]
10

-}


-- How to output a string to the console, do in-place update in Haskell!?

-- In a pure world, we must explictly keep track of any impure effects.
-- Do deal with in-place update, keep track of the state of variables.

type State = [(String, Int)]   -- Represents the name of a variable and its current value.

-- Read value.
readS :: String -> State -> (State,Int)
readS x w = case lookup x w of
                    Just v -> (w,v)

-- Overwrite by a a new value.
writeS :: (String, Int) -> State -> State
writeS (x,v) w =  (x,v) : [ (y,u) | (y,u) <- w, y /= x ]

-- x = x + 1;
inc_x :: State -> (State, Int)
inc_x st = let (st2,v) = readS "x" st
               st3 = writeS ("x", v+1) st2
               (st4, u) = readS "x" st3
           in (st4, u)


test_inc = let (st,v) = inc_x [("x",0)]
           in v


-- What out printing a string to the console?
-- In addition to the state of variables, must keep track of the state of the console.

type Console = [String]
type World = (State, Console)

readW :: String -> World -> (World, Int)
readW x (st,c) = case lookup x st of
                    Just v -> ((st,c),v)

printW :: String -> World -> World
printW out (st,c) = (st,c ++ [out])


-- and so on ...


-- SHORT SUMMARY:
-- "Simple" things like I/O, in-place updates seem really (really) difficult in Haskell.

-- SOLUTION:
-- In Haskell we capture side-effects via monads.
--
--  What is a monad?
--
--  Short and complicated answer.
--  A monad is a mathematical strucure known from category theory. See Kleisli triple, ...

--  Short and simple answer.
--  Monads allow for the systematic control of side effects where
--  (1) Computations and their results are described via types, and
--  (2) side-effecting computations are build via functional composition of primitive monad functions.
--  Thus, we can hide details such as (hidden) state etc.

-- "IO" is a monad, referred to as the "I/O" monad.
-- "IO Int" effectively represents "World -> (World, Int)"
incIO :: Int -> IO Int
incIO x = do print x
             return (x+1)


-- Alternative notation for the above.
incIO2 :: Int -> IO Int
incIO2 x = do { print x; return (x+1) }


-- In-place update of a variable implies that the variable is stored somewhere in memory.
-- In the C programming language, we can represent the memory location of an int variable via "int *".
-- In Haskell, write "IORef Int".

-- Side-effects that involve in-place updates are part of the IO monad.
incRef :: IORef Int -> IO Int
incRef x = do
  v <- readIORef x
  writeIORef x (v+1)
  return (v+1)

-- Variant where we return "nothing"
incRef2 :: IORef Int -> IO ()
incRef2 x = do
  v <- readIORef x
  writeIORef x (v+1)
  return ()

{-

// C version
int incRef(int* x) {
  int v = *x + 1;
  *x = v;
  return v;
-}


-- Example: Processing of a CSV File (see lecture notes).
-- (1) and (2) are IO (impure) actions, the rest of code consists of pure computations.
-- Types allow us to distinguish between pure and impure computations.

sumCSVFile :: FilePath -> IO ()
sumCSVFile fileName = do
   content <- readFile fileName                                                -- (1)
   let rows :: [String]
       rows = lines content
   let nrows :: [String]
       nrows = [ process row | row <- rows ]
               where
                  process :: String -> String
                  process row = let (studentID:ws) = splitOn "," row
                                    s = sum (map (\w -> (read w) :: Int) ws)
                                in studentID ++ " , " ++ (show s)
   let outFile = (takeBaseName fileName) ++ "-sum.csv"
   writeFile outFile (unlines nrows)                                           -- (2)

-- {-# LANGUAGE FlexibleInstances #-}
-- needed because of "List Int" instance.

{-

What are lists?
Collection of elements, e.g.
[1,2,3]

[True, False]

[[True], [True,False]]

where all the elements are of the same type.

More formally,

lists are either

(1) empty, or

(2) they are non-empty where we have
     head element and some tail.

How to implement this?
We need to formalize the language of lists.

Recall formal languages where we define a language
via a set of grammar rules.

For example, consider context-free languages (CFLs).

CFLs are defined via context-free grammars (CFGs).
What is a CFG?

Consider the following simple example.

L -> Null
L -> 1 L

L -> Null is a grammar (production) rule where

the left-hand side L is a non-terminal symbol.
It's call non-terminal, because we can replace L
by some right-hand side, in our case "1 L".

There are symbols we cannot replace. They are called
terminal symbols.

In our example, "1" and "Null" are terminal symbols.

For example, we can derive the following
where we always start with "L".

    L
->  1 L      (we apply L -> 1 L on L)
->  1 1 L    (we yet again apply L -> 1 L on L)
->  1 1 Null (we apply L -> Null on L)

In computer science, we use a "nicer" syntax for CFGs.

Instead of

L -> Null
L -> 1 L

we simply specify

L ::= Null | 1 L

This called the Extended Bakus-Naur Form (EBNF).

What has this to do with "algebraic data types".

In Haskell (and also other languages), we can
specify the set of our own values via "data" type equations.

In Haskell, we can specify lists as follows.

data List = Null | Cons Int List
                   ^^^^^

           Cons is a constructor that builds a list
           given some Integer (the head) and
           some other List (the tail).

           Null is a construtor but doesn't take any
           arguments. So, it's a constant.

Some rules:

     Constructor names must always be unique.
     So, we cannot reuse Null and Cons in some other
     "data" type definition.

-}


data List a = Null | Cons a (List a) deriving Show -- deriving (Show, Eq)

-- The following instances can be derived automatically.

{-

instance Show (List Int) where
   show Null = "Null"
   show (Cons x xs) = "Cons " ++ show x ++ "(" ++ show xs ++ ")"
                            --   Show Int

instance Show (List Bool) where
   show Null = "Null"
   show (Cons x xs) = "Cons " ++ show x ++ "(" ++ show xs ++ ")"
                              -- Show Bool
-}

-- Parametric instances. Subsumes the above two instances!
-- We can define show for values of type "List a",
-- if we can provide show for values of type "a".
-- Via "deriving Show" we can automatically obtain the following instance.

{-
instance Show a => Show (List a) where
   show Null = "Null"
   show (Cons x xs) = "Cons " ++ show x ++ "(" ++ show xs ++ ")"
                             --  Show a

-}

instance Eq a =>  Eq (List a) where
   Null == Null               = True
   (Cons x xs) == (Cons y ys) = x == y && xs == ys
   _ == _                     = False


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))


{-

Cons 1 (2 : [])

yields a type error cause the types

 List Int

and

 [Int]

are different.
-}

-- [True,False]
list2 :: List Bool
list2 = Cons True (Cons False Null)

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

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

{-

The following type checks.

Cons 1 (coerceF (2 : []))

-}

{-

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

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))

-- 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".

{-

EBNF Syntax of regular expressions and words

 R ::= 'x' | 'y' | ...              alphabet symbols
     | epsilon                      represents the empty string
     | R + R                        alternatives
     | R . R                        concatenation
     | R*                           Kleene star
     | (R)                          Grouping via parentheses


 W ::= epsilon | 'x' | 'y' | ...
   | W W

-}

-- Data type to represent regular expressions.
data R = Epsilon
       | Sym Char
       | Alt R R
       | Conc R R
       | Star R deriving Eq  -- automatically derive equality among regular expressions

{-
-- The following instance can be derived automatically.
instance Eq R where
   (==) Epsilon Epsilon = True
   (==) (Sym x) (Sym y) = x == y
   (==) (Alt r1 r2) (Alt s1 s2) = r1 == s1 && r2 == s2
   (==) (Conc r1 r2) (Conc s1 s2) = r1 == s1 && r2 == s2
   (==) (Star r) (Star s) = r == s
-}

-- Show instance for regular expressions
instance Show R where
  show Epsilon = ""
  show (Sym x) = [x]
  show (Alt r s) = "(" ++ show r ++  "+" ++ show s ++ ")"
  show (Conc r s) = "(" ++ show r ++  "." ++ show s ++ ")"
  show (Star s) = "(" ++ show s ++ ")" ++ "*"


-- some regular expressions plus short-hands
x = Sym 'x'
y = Sym 'y'

r1 = Star x
r2 = Star $ Alt x y
r3 = Conc y r2
r4 = Alt (Conc Epsilon r1) r1

-- Epsilon or r.
opt :: R -> R
opt r = Alt r Epsilon

-- One or more iterations.
kleenePlus :: R -> R
kleenePlus r = Conc r (Star r)


-----------------------------------------------------------------------
-- Writing functions that operate on data types via pattern matching.


-- Yield True if epsilon is part of the language, otherwise, we find False.
nullable :: R -> Bool
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

-- Simplifying expressions:
-- epsilon . R = R
-- R + R = R
--
-- We build a "fixpoint"!
-- We apply helper simp2 until no further simplifications can be applied.
-- Why is this necessary? Hint. Consider example r4.
simp :: R -> R
simp r = let s = simp2 r
         in if s == r then r
            else simp s
     where
        simp2 (Conc Epsilon r) = simp2 r
        simp2 (Conc r s) = Conc (simp2 r) (simp2 s)
        simp2 (Alt r s)
           | r == s    = simp2 r
           | otherwise = Alt (simp2 r) (simp2 s)
        simp2 (Star r) = Star $ simp2 r
        simp2 r = r

import Data.List (sort)

-- A student is represented by her name, student id and
-- a list of the courses the student is taking


{-

-- Previously:

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

Student is a synonym for (String, Int, [Int])

Why not?

data Student = MkStudent (String, Int, [Int])

Data types are tagged values. As there is only one case,
it is more efficient to create a new type that is isomorphic to (String, Int, [Int]).

-}

newtype Student = MkStudent (String, Int, [Int]) deriving Show

type DB = [Student]

-- Two students are equal if their student ids are equal.

eqStudent :: Student -> Student -> Bool
eqStudent (MkStudent (_, id1, _)) (MkStudent (_, id2, _)) = id1 == id2

instance Eq Student where
  (==) = eqStudent

-- We impose an ordering among students based on their student id

instance Ord Student where
  (<=) (MkStudent (_, id1, _)) (MkStudent (_, id2, _)) = id1 <= id2
  -- Recall: function (<=) vs operator <=
  -- (MkStudent (_, id1, _)) <= (MkStudent (_, id2, _)) = id1 <= id2



exDB1 = map MkStudent
          [("Jane", 112, [141, 252]), ("Jon", 111, [141, 252])]

{-
*Main> sort exDB1
[MkStudent ("Jon",111,[141,252]),MkStudent ("Jane",112,[141,252])]
-}

-- data Maybe a = Just a | Nothing

divSafe :: Int -> Int -> Maybe Int
divSafe x y = if y == 0
          then fail "division by zero"
          else return (x `div` y)

-- The above is monadic sugar for the following

divSafe2 :: Int -> Int -> Maybe Int
divSafe2 x y = if y == 0
          then Nothing
          else Just (x `div` y)


-- Writing programs as a composition of monadic functions.
divTwice x y = do  z <- divSafe x y
                   z2 <- divSafe z y
                   return z2

-- Above effectively corresponds to the following.
divTwice2 x y = case (divSafe x y) of
                   Just z ->  divSafe z y
                   Nothing -> Nothing

-- | QuickCheck light.
-- The following is re-implementation of the essential features of QuickCheck.

import System.Random (randomIO)
import Data.Char (chr)

class Arbitrary a where
   arbitrary :: IO a

-- Some generators

-- | Choose one of the elements.
elements :: [a] -> IO a
elements xs = do i <- randomIO :: IO Int
                 return (xs !! (i `mod` (length xs)))

-- | Generate a fixed number of arbitrary values.
vector ::  Arbitrary a => Int -> IO [a]
vector 0 = return []
vector n
    | n > 0  = do x <- arbitrary
                  xs <- vector (n-1)
                  return (x:xs)
    | otherwise = error "impossible"


-- Some Arbitrary instances

instance Arbitrary Char where
   arbitrary = do x <- elements [0..255]
                  return (chr x)

instance Arbitrary Bool where
   arbitrary = do x <- elements [True,False]
                  return x

instance Arbitrary a => Arbitrary [a] where
   arbitrary = vector 5

instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
   arbitrary = do b <- randomIO
                  if b
                    then do l <- arbitrary
                            return $ Left l
                    else do r <- arbitrary
                            return $ Right r


-- | Random generation of strings
genStrings :: IO ()
genStrings = do xs <- arbitrary
                putStrLn xs

-- | Random generation of strings
genEither :: IO ()
genEither = do { x <- arbitrary :: IO (Either String Bool);
               putStrLn (show x) }

-- | Quickly check a property by testing the property
-- against 100 arbitrarily generated test inputs.
quickCheck :: (Show t, Arbitrary t) => (t -> Bool) -> IO ()
quickCheck prop = go 100
   where go 0 = putStrLn "+++ Ok"
         go n = do x <- arbitrary
                   if prop x
                     then go (n-1)
                     else do putStrLn "*** Failed: "
                             print x



-- Property-based testing for count

-- | 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   = skip (/= ' ')
skipBlanks = skip (== ' ')

-- | Number of words counted must be greater or equal zero.
prop1 :: String -> Bool
prop1 s = count s >= 0

-- | Reversing the string yields the same number of words.
prop2 :: String -> Bool
prop2 s = count s == count (reverse s)


-- | Concatenating the string doubles the number of words.
-- NOTE: This property does not hold in general!
prop3 :: String -> Bool
prop3 s = 2 * count s == count (s ++ s)