import Data.List
import Test.QuickCheck

-- Exam from 2010-12 solved during the lecture. 

-- Q1 ------------------------------------------- 
--Q Give the type of the following function:
q1 :: Eq a => [[a]] -> a -> [[Bool]]

q1 [] _           = []
q1 ((x:xs):xss) y = [x == y] : q1 xss y

-- Q redefine it without recursion
q1 xss y = map (\(x:_) -> [x == y]) xss

-- Q Simplify:
q1b :: Bool -> Int -> String
q1b x y = show $ not x || odd y

--  | x && even y = "False"
--  | otherwise   = "True"


{- Q Define a function minmax (including its type) which given a
non-empty list returns a pair of the smallest and the largest element
in the list.  Your definition should use a single tail-recursive
helper function which computes the pair, and no other recursive
functions.

 -}
minmax (x:xs) = mm (x,x) xs
 where 
       mm (s,b) [] = (s,b)
       mm (s,b) (y:ys) = mm (min s y, max b y) ys

 -- or foldl (\(s,b) y -> (min s y, max b y)) (x,x) xs

-- Q2 ------------------------------------------------------------
{- 
This question is about representing and writing a type checker for
a tiny language of Haskell-like expressions. 

The subset of Haskell expressions, Hexp, has expressions of just
the following kinds: variables (identifiers) such as x, y and z,
integer literals such as 42 and -1, boolean literals True and False,
equality expressions of the form e1 == e2, and conditionals of the
form if e1 then e2 else e3, where e1, e2 and e3 stand for any Hexp
expressions.  -}

-- Q Define a datatype to represent  Hexpr
data Hexp = Var String | HI Integer | HB Bool | Heq Hexp Hexp
          | Hif Hexp Hexp Hexp
  deriving (Eq,Show) 

{- 
Q Give definitions for example1, and example2 
which should represent the following two Hexp
expressions (one of which is badly typed!):

if x == False then 2 else 3
if 54 == x then 42 else True

 -}

example1 = Hif (Heq (Var "x")  (HB False)) (HI 2) (HI 3)
example2 = Hif (Heq (HI 54)  (Var "x")) (HI 42) (HB True)

 {- 
To determine whether a given Hexp expression is type correct we need to know the type of the variables it contains. The following types can  be used to represent these things:
 -}

data HType = HBool | HInt deriving (Eq,Show) 
-- the type of an Hexp
type TEnv = [(String,HType)]                 
-- a type environment

-- Q Define a function 
hType :: TEnv -> Hexp -> Maybe HType 
hType t e = ht e
  where 
  ht (Var s) = lookup s t
  ht (HI _)  = Just HInt
  ht (HB _)  = Just HBool
  ht (Heq e1 e2) = case (ht e1, ht e2) of
                        (Just t1, Just t2) | t1 == t2 -> Just HBool 
                        _                             -> Nothing
  ht (Hif eb e1 e2) = case (ht eb, ht e1, ht e2) of
                        (Just HBool, Just t1, Just t2) 
                                     | t1 == t2 -> Just t1
                        _                       -> Nothing

prop_1 = hType [("x",HBool)] example1 == Just HInt
prop_2 = all (==Nothing) [hType [("x",HBool)] example2, 
                          hType [("x",HInt)] example2 ]

{- You may decide for yourself what your function does in the case
that the type environment does not have types for all variables in the
expression.  -}
------------------------------------------------------------------------
-- Question 3

type Position = (Int,Int)
type Maze = (Int, [Position]) -- positions of black squares

maze :: Maze
maze = (5,[(1,2),(1,4),(1,5),(2,2),(3,2),(3,3),(3,5),(4,2),(5,4)])

type Path = [Position] -- sequence of connected whites, last to first.
path = [(5,5),(4,5),(4,4),(4,3),(5,3),(5,2),(5,1)] 
------ 
-- Q 
neighbour :: Maze -> Position -> [Position]
neighbour (d,bs) (x,y) =  -- white squares adjacent to the given position
   [p | p <- adjacent, nonBlack p, valid p]
  where adjacent = [(x+1,y),(x-1,y),(x,y+1),(x,y-1)]
        nonBlack p = p `notElem` bs
        valid (a,b) = all (\z -> z > 0 && z <= d) [a,b]
        
-- Q 
extend :: Maze -> Path -> [Path]
-- all ways to extend the path with one more white square
extend mz (p:ps) = [q:p:ps | q <- neighbour mz p, q `notElem` ps]

-- Q 
allpaths :: Maze -> Position -> [Path]
allpaths mz ps = 
  concat $ takeWhile (not.null) $ iterate (extendAll mz) [[ps]]

extendAll :: Maze -> [Path] -> [Path]
extendAll mz =  concatMap (extend mz)

-- extend mz :: Path -> [Path]

-- 
fromto :: Maze -> Position -> Position -> [Path]
-- all paths from start to end
fromto mz st en =  [p:ps | p:ps <- allpaths mz st, p == en ]
                -- filter ((== en) . head) $ allpaths mz st

-- Q 4 ------------------------------------------------------
data TestMaze = M Maze deriving (Eq,Show)
instance Arbitrary TestMaze where
  arbitrary = do 
        i <- arbitrary
        let d = 1 + abs i
        bs <- listOf (square d) 
        return $ M (d, nub bs)  
-- impractical for testing but OK otherwise!

square d = do 
     x <- choose (1,d)
     y <- choose (1,d)
     return (x,y)
            

-- ensuring that mazes are well formed: squares within dimention and 
-- no duplicates 
prop_fromto (d,bs) = not (null whites) ==> -- missed this in the lec
   sort startEnd ==  sort ( map reverse endStart )
  where
     startEnd = fromto (d,bs) start end
     endStart = fromto (d,bs) end start
     white = [(x,y) | x <- [1..d], y <- [1..d]] \\ bs
     start = head white
     end   = last white

-- discussed that this is not a very practical test, 
-- so don't expect it to work as-is.