{-  Exploring Languages with Interprters and Functional Programming
    Chapter 15: Higher-Order Functions
    Copyright (C) 2018, H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2018-07-11: Revised for 2018 textbook Chapter 15

-}

module HigherOrderFunctions
where
    import Data.List ( foldl' )

-- Map
    squareAll :: [Int] -> [Int] 
    squareAll []     = [] 
    squareAll (x:xs) = (x * x) : squareAll xs

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

    map' :: (a -> b) -> [a] -> [b]  -- map in Prelude
    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

-- Filter
    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

    filter' :: (a -> Bool) -> [a] -> [a]  -- filter in Prelude
    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)

-- Fold right
    sum' :: [Int] -> Int  -- sum in Prelude
    sum' []     = 0
    sum' (x:xs) = x + sum' xs 

    product' :: [Integer] -> Integer  -- product in Prelude
    product' []     = 1 
    product' (x:xs) = x * product' xs 

    concat' :: [[a]] -> [a]  -- concat in Prelude
    concat' []       =  []
    concat' (xs:xss) =  xs ++ concat' xss

    foldrX :: (a -> b -> b) -> b -> [a] -> b  -- foldr in Prelude
    foldrX f z []     = z
    foldrX f z (x:xs) = f x (foldrX f z xs) 

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

    product2 :: [Int] -> Int     -- product
    product2 xs = foldrX (*) 1 xs

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

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

    map2 :: (a -> b) -> [a] -> [b] -- map
    map2 f xs = foldr mf [] xs 
        where mf y ys = (f y) : ys
 
    filter2 :: (a -> Bool) -> [a] -> [a]  -- filter
    filter2 p xs = foldr ff [] xs
        where ff y ys = if p y then (y:ys) else ys

    length2 :: [a] -> Int  -- length
    length2 xs  = foldr len  0  xs
        where len _ acc = acc + 1

    append2 :: [a] -> [a] -> [a]  -- ++
    append2 xs ys = foldr (:) ys xs

-- Fold left
    foldlX :: (a -> b -> a) -> a -> [b] -> a  -- foldl in Prelude
    foldlX f z []     = z  
    foldlX f z (x:xs) = foldlX f (f z x) xs

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

    length3 :: [a] -> Int   -- length
    length3 xs  = foldl len 0  xs
        where len acc _ = acc + 1

    reverse2 :: [a] -> [a]  -- reverse
    reverse2 xs = foldl rev [] xs
        where rev acc x = (x:acc) 

    foldr2 :: (a -> b -> b) -> b -> [a] -> b  -- foldr
    foldr2 f z xs = foldl flipf z (reverse xs)
        where flipf y x = f x y

-- concatMap
    concatMap' :: (a -> [b]) -> [a] -> [b] 
    concatMap' f xs = concat(map f xs)

    concatMap2 :: (a -> [b]) -> [a] -> [b] 
    concatMap2 f xs = foldr fmf [] xs 
        where fmf x ys = f x ++ ys

    filter3 :: (a -> Bool) -> [a] -> [a]
    filter3 p xs = concatMap fmf xs
        where fmf x = if p x then [x] else []