import Test.QuickCheck
import Data.List
import Data.Maybe

--------------------------------------------------------------------------
-- 1. Exercises from The Craft of Functional Programming

size :: Expr -> Int
size (Lit _)   = 0
size (Add a b) = 1 + size a + size b
size (Sub a b) = 1 + size a + size b

---

data Expr
  = Lit Int
  | Add Expr Expr
  | Sub Expr Expr
  | Mul Expr Expr
  | Div Expr Expr
 deriving ( Eq, Show )

eval :: Expr -> Int
eval (Lit n)   = n
eval (Add a b) = eval a + eval b
eval (Sub a b) = eval a - eval b
eval (Mul a b) = eval a * eval b
eval (Div a b) = eval a `div` eval b

---

evalMaybe :: Expr -> Maybe Int
evalMaybe (Lit n)   = Just n

evalMaybe (Add a b) = evalMaybe a `add` evalMaybe b
 where
  Nothing `add` _       = Nothing
  _       `add` Nothing = Nothing
  Just x  `add` Just y  = Just (x+y)

evalMaybe (Sub a b) = evalMaybe a `sub` evalMaybe b
 where
  Nothing `sub` _       = Nothing
  _       `sub` Nothing = Nothing
  Just x  `sub` Just y  = Just (x-y)

evalMaybe (Mul a b) = evalMaybe a `mul` evalMaybe b
 where
  Nothing `mul` _       = Nothing
  _       `mul` Nothing = Nothing
  Just x  `mul` Just y  = Just (x*y)

evalMaybe (Div a b) = evalMaybe a `dvv` evalMaybe b
 where
  Nothing `dvv` _        = Nothing
  _       `dvv` Nothing  = Nothing
  _       `dvv` (Just 0) = Nothing
  Just x  `dvv` Just y   = Just (x `div` y)

---

-- Alternative implementation that simplifies matters by concentrating the
-- pattern matching on `Just`/`Nothing` to a single place:

data Expr'
  = Lit' Int
  | Op Ops Expr' Expr'
 deriving ( Eq, Show )

data Ops = Add' | Sub' | Mul' | Div' | Mod'
 deriving ( Eq, Show )

eval' :: Expr' -> Maybe Int
eval' (Lit' n)    = Just n
eval' (Op op a b) = ops op (eval' a) (eval' b)
 where
  ops _   Nothing  _                   = Nothing
  ops _   _        Nothing             = Nothing
  ops op  _        (Just 0) | isDiv op = Nothing
  ops op  (Just x) (Just y)            = Just (evalOp op x y)

  isDiv op = op `elem` [Div',Mod']

  evalOp Add' x y = x + y
  evalOp Sub' x y = x - y
  evalOp Mul' x y = x * y
  evalOp Div' x y = x `div` y
  evalOp Mod' x y = x `mod` y

---

-- Side note: The above can be greatly simplified by using do-notation. This is
-- because `Maybe` can be seen as and "instruction type", just like `IO`. For
-- example, this code does the same as `evalMaybe` for the `Add` case:

evalMaybe' (Add a b) = do
    a' <- evalMaybe' a
    b' <- evalMaybe' b
    return (a'+b')

--------------------------------------------------------------------------

data Tree
    = Leaf Int
    | Split Tree Tree
 deriving ( Eq, Show )

---

collapse :: Tree -> [Int]
collapse (Leaf a)    = [a]
collapse (Split l r) = collapse l ++ collapse r

---

mirror :: Tree -> Tree
mirror (Split l r) = Split (mirror r) (mirror l)
mirror t           = t

---

genTree :: Int -> Gen Tree
genTree s = frequency
    [ (s, do l <- genTree s'
             r <- genTree s'
             return (Split l r))
    , (1, do a <- arbitrary
             return (Leaf a)
      )
    ]
  where
    s' = s `div` 2

instance Arbitrary Tree where
  arbitrary = sized genTree

prop_mirrorMirror t = mirror (mirror t) == t

---

prop_mirrorCollapse t = collapse (mirror t) == reverse (collapse t)



--------------------------------------------------------------------------
-- 2. Exercises on type Expr from the Lecture

{-
See file AnswersWeek6ExprVar.hs
-}



--------------------------------------------------------------------------
-- 3. File Systems

data File
  = File String
  | Dir String [File]
 deriving ( Eq, Show )

type FileSystem = [File]

-- this function returns all paths
search :: FileSystem -> String -> [String]
search files name =
  [ name
  | File name' <- files
  , name == name'
  ] ++
  [ dir ++ "/" ++ path
  | Dir dir files' <- files
  , path <- search files' name
  ]

-- this function returns maybe a path
searchMaybe :: FileSystem -> String -> Maybe String
searchMaybe files name =
  listToMaybe
  ( [ name
    | File name' <- files
    , name == name'
    ] ++
    [ dir ++ "/" ++ path
    | Dir dir files' <- files
    , Just path <- [searchMaybe files' name]
    ]
  )

-- it can also be defined using the first one...
searchMaybe' :: FileSystem -> String -> Maybe String
searchMaybe' files name = listToMaybe (search files name)

exampleFileSystem :: FileSystem
exampleFileSystem =
  [ File "apa"
  , Dir "bepa" [ File "apa", Dir "bepa" [], Dir "cepa" [ File "bepa" ] ]
  , Dir "cepa" [ Dir "bepa" [], Dir "cepa" [ File "apa" ] ]
  ]



--------------------------------------------------------------------------
-- 4. Exercises on Propositional Logic

data Proposition = Var Name
                 | Proposition :&: Proposition
                 | Proposition :|: Proposition
                 | Not Proposition
 deriving ( Eq, Show )

type Name = String

---

vars :: Proposition -> [Name]
vars (Var x)   = [x]
vars (a :&: b) = vars a `union` vars b
vars (a :|: b) = vars a `union` vars b
vars (Not a)   = vars a

truthValue :: [(Name,Bool)] -> Proposition -> Bool
truthValue val (Var x)   = fromJust (lookup x val)
truthValue val (a :&: b) = truthValue val a && truthValue val b
truthValue val (a :|: b) = truthValue val a || truthValue val b
truthValue val (Not a)   = not (truthValue val a)

---

-- allVals xs enumerates all possible valuations of the variables xs:
--    1. when xs = [], there is just one valuation
--    2. otherwise, we enumerate all possible valuations for the rest
--       of the variables, plus all possible values of x
allVals :: [Name] -> [[(Name,Bool)]]
allVals []     = [[]]
allVals (x:xs) = [ (x,b):val
                 | val <- allVals xs
                 , b <- [False,True]
                 ]

tautology :: Proposition -> Bool
tautology a =
  and [ truthValue val a | val <- allVals (vars a) ]

-- an example
hamlet :: Proposition
hamlet = Var "to be" :|: Not (Var "to be")



---------------------------------------------------------------------
-- 5. Approximating 0-solutions to functions

solve :: (Double -> Double) -> (Double,Double) -> Double
solve f (x0,x1)
  | fx =? 0            = x
  | x0 == x1           = error "no solution found!"
  | fx0 > 0 || fx1 < 0 = error "interval does not contain 0!"
  | fx < 0             = solve f (x,x1)
  | fx > 0             = solve f (x0,x)
 where
  x   = (x0 + x1) / 2
  fx  = f x
  fx0 = f x0
  fx1 = f x1

  x =? y = abs (x-y) < 0.0000000001