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


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

-}


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

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



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


{-

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)

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


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


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


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

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



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


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


-- 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 name of a variable and its current 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 ]

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.

data List a = Null | Cons a (List a) 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
-}

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

{-

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 "fixpont"!
-- 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