module Chap06
where

    import Data.List -- need this for foldl'

{- 6.1 -}
    squareAll :: [Int] -> [Int] 
    squareAll []     = [] 
    squareAll (x:xs) = (x * x) : squareAll xs

    lengthAll :: [[a]] -> [Int] 
    lengthAll []       = [] 
    lengthAll (xs:xss) = (length xs) : lengthAll xss

    -- similar to map in standard prelude
    map' :: (a -> b) -> [a] -> [b] 
    map' f []     = [] 
    map' f (x:xs) = f x : map' f xs 

    squareAll2 :: [Int] -> [Int] 
    squareAll2 xs = map' sq xs 
                    where sq x = x * x 

    lengthAll2 :: [[a]] -> [Int] 
    lengthAll2 xss = map' length xss

{- 6.2 -}
    getEven :: [Int] -> [Int] 
    getEven []            = [] 
    getEven (x:xs)   
              | even x    = x : getEven xs 
              | otherwise = getEven xs

    doublePos :: [Int] -> [Int] 
    doublePos []          = [] 
    doublePos (x:xs) 
              | 0 < x     = (2 * x) : doublePos xs 
              | otherwise = doublePos xs

    -- similar to filter in standard prelude
    filter' :: (a -> Bool) -> [a] -> [a] 
    filter' _ []    = [] 
    filter' p (x:xs) 
        | p x       = x : xs' 
        | otherwise = xs' 
                    where xs' = filter' p xs

    getEven2 :: [Int] -> [Int] 
    getEven2 xs = filter' even xs 

    doublePos2 :: [Int] -> [Int] 
    doublePos2 xs = map' dbl (filter' pos xs) 
                    where dbl x  = 2 * x  
                          pos x = (0 < x)

{- 6.3 -}
    concat' :: [[a]] -> [a] 
    concat' []       =  []                 -- nil list of lists 
    concat' (xs:xss) =  xs ++ concat' xss  -- non-nil list of lists

    sumlist :: [Int] -> Int 
    sumlist []     = 0               -- nil list 
    sumlist (x:xs) = x + sumlist xs  -- non-nil list 

    -- similar to foldr in standard prelude
    foldrX :: (a -> b -> b) -> b -> [a] -> b 
    foldrX f z []     = z  
    foldrX f z (x:xs) = f x (foldrX f z xs) 

    concat2:: [[a]] -> [a] 
    concat2 xss = foldrX (++) [] xss 

    sumlist2 :: [Int] -> Int 
    sumlist2 xs = foldrX (+) 0 xs

    and', or' :: [Bool] -> Bool 
    and' xs = foldrX (&&) True xs 
    or'  xs = foldrX (||) False xs

    -- similar to foldl in standard prelude
    foldlX :: (a -> b -> a) -> a -> [b] -> a 
    foldlX f z []     = z  
    foldlX f z (x:xs) = foldlX f (f z x) xs

    sum', product' :: Num a => [a] -> a 
    sum' xs     = foldl' (+) 0 xs 
    product' xs = foldl' (*) 1 xs

{- 6.4 -}
    two :: a -> Int 
    two x = 2

    infixr 3 &&&
    infixr 2 |||

--  && and || in standard prelude
    (&&&), (|||) :: Bool -> Bool -> Bool 
    False &&& x = False  -- second argument not evaluated 
    True  &&& x = x 

    False ||| x = x 
    True  ||| x = True   -- second argument not evaluated

{- 6.5 -}
    add :: (Int,Int) -> Int 
    add (x,y) = x + y 

    add' :: Int -> (Int -> Int) 
    add' x y  = x + y 

    doublePos3 :: [Int] -> [Int] 
    doublePos3 xs = map' ((*) 2) (filter' ((<) 0) xs)

{- 6.6 -}
    flip' :: (a -> b -> c) -> b -> a -> c 
    flip' f x y = f y x

    sumCubes :: [Int] -> Int 
    sumCubes xs = sum' (map' (^3) xs)

    sum2 = foldl' (+) 0

{- 6.7 -}
    const' :: a -> b -> a 
    const' k x = k

    id' :: a -> a 
    id' x = x

    fst' :: (a,b) -> a 
    fst' (x,_) = x 

    snd' :: (a,b) -> b 
    snd' (_,y) = y

    reverse' :: [a] -> [a]          -- reverse elements of list 
    reverse' = foldlX (flip' (:)) []

{- 6.8 -}
    infixr 9 #
    (#) :: (b -> c) -> (a -> b) -> (a -> c) 
    (f # g) x = f (g x)

    count :: Int -> [[a]] -> Int 
    count n 
        | n >= 0    = length . filter' (== n) . map' length 
        | otherwise = const' 0   -- discard 2nd arg, return 0

    doublePos4 :: [Int] -> [Int] 
    doublePos4 = map' (2*) . filter' (0<)

    last' = head . reverse'
    init' = reverse' . tail . reverse'

    last2 :: [a] -> a 
    last2 [x]    = x 
    last2 (_:xs) = last2 xs 

    init2 :: [a] -> [a] 
    init2 [x]    = [] 
    init2 (x:xs) = x : init2 xs

    any', all' :: (a -> Bool) -> [a] -> Bool 
    any' p = or'  . map' p 
    all' p = and' . map' p

    elem', notElem' :: Eq a => a -> [a] -> Bool 
    elem'    = any' . (==) 
    notElem' = all' . (/=) 

{- 6.9 -}
    length' :: [a] -> Int  -- calculate length of list 
    length'  = foldl' (\n _ -> n+1) 0

{- 6.10 -}
    takeWhile':: (a -> Bool) -> [a] -> [a] 
    takeWhile'  p []  = [] 
    takeWhile'  p (x:xs) 
        | p x        = x : takeWhile' p xs 
        | otherwise  = [] 

    dropWhile' :: (a -> Bool) -> [a] -> [a] 
    dropWhile'  p []  = [] 
    dropWhile'  p xs@(x:xs') 
        | p x        = dropWhile' p xs' 
        | otherwise  = xs

{- 6.11 -}
    zipWith' :: (a->b->c) -> [a]->[b]->[c] 
    zipWith' z  (x:xs)  (y:ys) = z x y : zipWith' z xs ys 
    zipWith' _  _     _        = []

    zip' :: [a] -> [b] -> [(a,b)] 
    zip' = zipWith' (\x y -> (x,y)) 

    sp :: Num a => [a] -> [a] -> a 
    sp xs ys = sum' (zipWith' (*) xs ys)

{- 6.13 -}
    gmerge :: Ord d => 
        (a -> d) ->        -- keya 
        (b -> d) ->        -- keyb 
        [c] ->             -- e1 
        ([b] -> [c]) ->    -- e2 
        ([a] -> [c]) ->    -- e3 
        (a -> b -> [c]) -> -- f4 
        (a -> b -> [c]) -> -- f5 
        (a -> b -> [c]) -> -- f6 
        ([a] -> [a]) ->    -- g4 
        ([a] -> [a]) ->    -- g5 
        ([a] -> [a]) ->    -- g6 
        ([b] -> [b]) ->    -- h4 
        ([b] -> [b]) ->    -- h5 
        ([b] -> [b]) ->    -- h6 
        [a] -> [b] -> [c] 
    gmerge keya keyb e1 e2 e3 f4 f5 f6 g4 g5 g6 h4 h5 h6 
        = gmerge' 
          where 
            gmerge'  []  []        = e1 
            gmerge'  []  bs@(y:ys) = e2 bs 
            gmerge'  as@(x:xs)  [] = e3 as 
            gmerge'  as@(x:xs)  bs@(y:ys) 
                | keya x <  keyb y = f4 x y ++ gmerge' (g4 as) (h4 bs)  
                | keya x == keyb y = f5 x y ++ gmerge' (g5 as) (h5 bs)  
                | keya x >  keyb y = f6 x y ++ gmerge' (g6 as) (h6 bs)

    merge1' :: Ord a => [a] -> [a] -> [a] 
    merge1' = gmerge  id id   -- keya, keyb 
       [] id id               -- e1, e2, e3 
       (const . (:[]))        -- f4 
       (const . (:[]))        -- f5 
       (flip (const . (:[]))) -- f6 
       tail tail id           -- g4, g5, g6        
       id id tail             -- h4, h5, h6
.