-- 2013-12-09

-- Code-up of the exam from 2012-12

import Data.List 
import Test.QuickCheck
import System.Random
import Data.Maybe
import System.Directory

-- Consider the following function:

chat 0 f (x:xs) = f x : xs
chat _ _ []     = []
chat n f (x:xs) = x:chat (n-1) f xs

chat' n f xs =  [ if  i == n then f v else v | (i,v) <- zip [0..] xs ]

chat'' n f xs = case splitAt n xs of 
                     (ys,(xn:zs)) -> ys ++ f xn : zs
                     (ys, [])     -> ys

-- You may assume that the first argument to 
-- chat will be a non-negative Int.

-- (a) Give the type of chat (2p) 
chat :: Int -> (a -> a) -> [a] -> [a]
{- (b) (3p) 
Give a definition for a function chat' 
which is equivalent to chat (under the 
assumption about the first argument),
but which is defined using only the 
standard functions (as listed at the back).
 -}

--------------------
{- (c) (2p) 
Define a quickCheck property that could be used 
to test the equivalence of chat and chat'. 
In your test you may use a specific function 
for the second parameter of chat. 
 -}

prop_chat n xs = let n' = abs n in
   chat n' not xs == chat' n' not xs

-------------------
{- (d) (3p)
A function findIn tries to find the earliest index at which its first argument can be found as a sublist of the second argument. It satisfies the following property:
-}
-- prop_findIn0 = findIn "Hell" "Hello"      == Just 0 
--            && findIn "ell" "Hello Jello" == Just 1
--            && findIn "Hell" "Helan"      == Nothing
{-
With the help of the function isPrefixOf, 
give a definition of findIn, 
including its most general type,  
using a tail-recursive helper function. 
 -}
findIn needle haystack = findAt 0 haystack
       where findAt n [] = Nothing
             findAt n xs 
                    | needle `isPrefixOf` xs = Just n
                    | otherwise              = findAt (n+1) (tail xs) 
-------------------
{- (f) (3p) 
Define a quickCheck property which checks that
whenever a list ys definitely contains xs as a sublist, 
then findIn xs ys will not give Nothing.  
Note: it is not necessary to create a new generator 
for lists to answer this question. 
 -}
prop_findIn xs ys zs = findIn ys (xs ++ ys ++ zs) /= Nothing
            where types = xs :: [Bool]
--------------------------------------------------------
--- Question 2

type Journey = [Leg]
type Place = String

data Leg = Leg Place Mode Place
  deriving Show
data Mode = Bus | Train | Flight
  deriving (Eq,Show)

-- (a) (2 points) 
-- Complete the definition of the data type for a Journey.

-- (b) (3 points) Define a function  
connected :: Journey -> Bool
connected j =  and [ a == b | 
               ((Leg _ _ a), (Leg b _ _)) <- zip (init j) (tail j) ]
-- no recursion. hint use: zip (init journey) (tail journey)


-- (c) (4 points)
-- Define, using recursion and none of the standard functions 
-- except for those in the Eq class, a function
missingLegs :: Journey -> [(Place,Place)]
missingLegs (Leg _ _ a : Leg b m c : legs) 
  | a /= b    = (a,b) : missingLegs (Leg b m c :legs)
  | otherwise = missingLegs (Leg b m c :legs)
missingLegs _ = []
 
-- which computes the pairs of places that are not connected 
-- in the given Journey. This should satisfy:

prop_missingLegs j = not(null j) ==> 
       connected j == null (missingLegs j)

-- (d) (4 points) Add appropriate instance declarations 
-- so that quickCheck can be run on prop_missingLegs.

instance Arbitrary Leg where
  arbitrary = do 
            let place = elements ["A","B","C"]
            from <- place
            to <- place
            mode <- elements [Bus,Train,Flight]
            return $ Leg from mode to

            -------------------------------------------------------------
-- Question 3
-- The map of a simple text-based adventure game is modelled as

data Map = Map PlaceName [(Dir,Map)] -- deriving Show 
data Dir = N | S | E | W  
       deriving (Eq,Show)
type PlaceName = String

-- Example: 
hogwarts = Map "Castle" [(N,forest),(S,lake)]
forest   = Map "Forest" [(S,hogwarts)]
lake     = Map "Lake"   [(N,hogwarts)] 

-- assume that (i) a direction appears at most once in a list 
-- and (ii) every distinct place in a map has a unique place name. 

-- (a) (4 points) Define a function
travel ::  Map -> [Dir] -> Maybe Map
travel (Map h dirs) (d:ds) = case lookup d dirs of 
                                  Just m -> travel m ds
                                  Nothing -> Nothing
travel m            []     = Just m
                        
--  travel hogwarts [N,S,S]    Just lake 
--  travel hogwarts [N,E] == Nothing
--  travel hogwarts [N,N] == Nothing 
-- Hint: the function lookup can be useful here. 

-- (b) (1 point) If we add deriving Show to Map, 
-- what happens when we try to print hogwarts?

-- (c) (6 points) Make Map an instance of class Show 
-- in a way that allows maps to be
-- displayed in the following way:
{- 
> lake
You are at the Lake. Go N to Castle
Castle. Go N to Forest, Go S to Lake
Forest. Go S to Castle

> forest
You are at the Forest. Go S to Castle
Castle. Go N to Forest, Go S to Lake
Lake. Go N to Castle

Hints: the function intersperse could come in handy. 
As a wise man once said, to avoid going round in circles, 
it can be useful to remember where you've been.
 -}
instance Show Map where
  show m = "You are at the " ++ showMap [] m

showMap seenB4 (Map h ds) 
 | h `elem` seenB4 = ""
 | otherwise = showHere ++ showDirs ++ "\n" ++ showOtherMaps              where 
         showHere  = h ++ ". "
         showDirs  = 
          concat (intersperse ", " 
            [ "Go " ++ show d ++ " to " ++ h' | (d,Map h' _) <- ds]) 
         showOtherMaps = 
          unlines [ showMap (h:seenB4) m  | (_,m) <- ds] 

-----------------------------------------------------
-- Question 4
-- (a) Rewrite without do notation:
backup f = do 
      a <- readFile f
      let backup = f ++ ".bac"
      putStrLn $ "Creating backup in " ++ backup
      writeFile backup a 

backup' f = readFile f >>= \a -> 
            let backup = f ++ ".bac" in
                putStrLn ("Creating backup in " ++ backup)
                >> writeFile backup a

-- (b) (2 points) 
-- For-loops found in typical imperative programs ...
-- you should define a function for_ of type 

-- for_ :: [a] -> (a -> IO()) -> IO()
{-
which can represent simple for loops.
For example a (psudocode) for loop 
 for i = i to 10 {
      print i
-}
example = for_ [1..10]  $ \i -> 
            print i
 
for_ range c = sequence_ $ map c range

-- (c) (1 point) 
--  Give a definition for a more general function 
-- which collects the results of each iteration. 
-- for :: [a] -> (a -> IO b) -> IO [b]
for range c = sequence $ map c range

-- (d) (2 points)  
{- Sometimes a large file (such as a video) needs to be split 
into  a collection of smaller files.  
Suppose that these smaller files are named f.part1, f.part2,...
This question is about joining them back together again to get 
the original file f.

Use the function for to define the function 
-}
join :: FilePath -> Int -> IO()
{-
such that join f i, when run,   
concatenates  the contents of the i parts of file f together
and writes them back into file f. 
You may assume that f and i are
correctly specified. FilePath is equivalent to String.
 -}
join f i = do 
   parts <- for [1..i] $ \j -> 
               readFile (f ++ ".part" ++ show i)
   writeFile f (concat parts)