module Sol04 where

import Data.List
import HL04STAL
import SetEq

-- 4.44
-- The definition could run like this:
-- L<K :≡ |L| < |K|
--        ∨ (|L| = |K|
--          ∧∃x, xs, y, ys (L = x : xs ∧ K = y : ys ∧ (x < y ∨ (x = y ∧ xs < ys)))).
compare' :: (Ord a) => [a] -> [a] -> Ordering
compare' [] [] = EQ
compare' (x : xs) (y : ys)
  | length (x : xs) < length (y : ys) = LT
  | length (x : xs) > length (y : ys) = GT
  | otherwise = compare (x : xs) (y : ys)

-- And here is how it compares with the standard implementation of compare:
-- Sol4> compare [1,3] [1,2,3]
-- GT
-- Sol4> compare’ [1,3] [1,2,3]
-- LT
-- Sol4> compare [1,3] [1,2]
-- GT
-- Sol4> compare’ [1,3] [1,2]
-- GT

-- 4.46 Since reverse is predefined, we call our version reverse'.
reverse' :: [a] -> [a]
reverse' [] = []
reverse' (x : xs) = reverse' xs ++ [x]

-- 4.47
splitList :: [a] -> [([a], [a])]
splitList [x, y] = [([x], [y])]
splitList (x : y : zs) = ([x], (y : zs)) : addLeft x (splitList (y : zs))
  where
    addLeft u [] = []
    addLeft u ((vs, ws) : rest) = (u : vs, ws) : addLeft u rest

-- A neater version results when we avail ourselves of the map function:
split :: [a] -> [([a], [a])]
split [x, y] = [([x], [y])]
split (x : y : zs) =
  ([x], (y : zs)) : (map (\(us, vs) -> ((x : us), vs)) (split (y : zs)))

-- 4.48
q11 = [y | (x, y) <- act, x == "Robert De Niro" || x == "Kevin Spacey"]

-- 4.49
q12 =
  nub
    ( [y | ("Quentin Tarantino", y) <- act, releaseP (y, "1994")]
        ++ [y | ("Quentin Tarantino", y) <- direct, releaseP (y, "1994")]
    )

-- 4.50
q13 = [x | (x, y) <- release, y > "1997", not (actP ("William Hurt", x))]

-- 4.51
difference :: (Eq a) => [a] -> [a] -> [a]
difference xs [] = xs
difference xs (y : ys) = difference (delete y xs) ys

-- 4.53
genUnion :: (Eq a) => [[a]] -> [a]
genUnion [] = []
genUnion [xs] = xs
genUnion (xs : xss) = union xs (genUnion xss)

genIntersect :: (Eq a) => [[a]] -> [a]
genIntersect [] = error "list of lists should be non-empty"
genIntersect [xs] = xs
genIntersect (xs : xss) = intersect xs (genIntersect xss)

-- 4.54
unionSet :: (Eq a) => Set a -> Set a -> Set a
unionSet (Set []) set2 = set2
unionSet (Set (x : xs)) set2 =
  insertSet x (unionSet (Set xs) (deleteSet x set2))

intersectSet :: (Eq a) => Set a -> Set a -> Set a
intersectSet (Set []) set2 = Set []
intersectSet (Set (x : xs)) set2
  | inSet x set2 = insertSet x (intersectSet (Set xs) set2)
  | otherwise = intersectSet (Set xs) set2

differenceSet :: (Eq a) => Set a -> Set a -> Set a
differenceSet set1 (Set []) = set1
differenceSet set1 (Set (y : ys)) =
  differenceSet (deleteSet y set1) (Set ys)

-- 4.55
-- insertSet will now have to insert an item at the right position to keep the underlying list sorted.
-- This can be done in terms of an auxiliary function insertList, as follows:
insertSet' :: (Ord a) => a -> Set a -> Set a
insertSet' x (Set s) = Set (insertList x s)

insertList x [] = [x]
insertList x ys@(y : ys') = case compare x y of
  GT -> y : insertList x ys'
  EQ -> ys
  _ -> x : ys

-- 4.56
-- The only thing that is needed is a small patch in the function showSet, like this:
showSet [] str = showString "0" str
showSet (x : xs) str = showChar ' ' (shows x (showl xs str))
  where
    showl [] str = showChar ' ' str
    showl (x : xs) str = showChar ',' (shows x (showl xs str))