{-  Exploring Languages with Interprters and Functional Programming
    Chapter 16: Haskell Function Concepts
    Copyright (C) 2018, H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

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

-}

module FunctionConcepts
where
    import Data.List ( foldl' )

--  import functions from chapter 15
    import HigherOrderFunctions

-- nonstrict example

    two :: a -> Int 
    two x = 2

-- definitions of && and || changed to &&& and ||| to avoid conflict

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

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

    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) 

    f, g :: a -> a
    f x = x

    g x = f x

    g' = f

    flip' :: (a -> b -> c) -> b -> a -> c  -- flip in Prelude
    flip' f x y = f y x

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

--  sum = foldl' (+) 0  -- sum

    const' :: a -> b -> a  -- const in Prelude
    const' k x = k

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

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

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

    reverse' :: [a] -> [a]      -- reverse in Prelude
    reverse' = foldlX (flip' (:)) []
    
    curry' :: ((a, b) -> c) -> a -> b -> c
    curry' f x y =  f (x, y)

    uncurry' :: (a -> b -> c) -> ((a, b) -> c)
    uncurry' f p =  f (fst p) (snd p)


    fork :: (a -> b, a -> c) -> a -> (b,c)
    fork (f,g) x = (f x, g x)

    cross :: (a -> b, c -> d) -> (a,c) -> (b,d)
    cross (f,g) (x,y) = (f x, g y)
 
    
-- commented out for complation
--      infixr 9 .
--      (.) :: (b -> c) -> (a -> b) -> (a -> c) 
--      (f . g) x = f (g x) 
--
--      doit x = f1 (f2 (f3 (f4 x))) 
--
--      doit = f1 . f2 . f3 . f4 

    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'        -- last in Prelude
    init' = reverse' . tail . reverse' -- init in Prelude

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

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

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

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

    squareAll3 :: [Int] -> [Int] 
    squareAll3 xs = map (\x -> x * x) xs 

    length4 :: [a] -> Int   -- length in Prelude
    length4  = foldl' (\n _ -> n+1) 0

    foldlP :: (a -> b -> a) -> a -> [b] -> a  -- foldl' in Data.List 
    foldlP  f z []    = z 
    foldlP f z (x:xs) = y `seq` foldlP f y xs 
                where y = f z x 

    foldlQ :: (a -> b -> a) -> a -> [b] -> a  -- foldl' in Data.List 
    foldlQ f z []     = z 
    foldlQ f z (x:xs) = (foldlQ f $! f z x) xs

    sum4 :: [Integer] -> Integer  
    sum4 xs = sumIter xs 0
        where sumIter []     acc = acc
              sumIter (x:xs) acc = sumIter xs (acc+x)

    sum5 :: [Integer] -> Integer  
    sum5 xs = sumIter xs 0
        where sumIter []     acc = acc
              sumIter (x:xs) acc = sumIter xs $! acc + x