{-
  * Copyright (c): Uwe Schmidt, FH Wedel
  *
  * You may study, modify and distribute this source code
  * FOR NON-COMMERCIAL PURPOSES ONLY.
  * This copyright message has to remain unchanged.
  *
  * Note that this document is provided 'as is',
  * WITHOUT WARRANTY of any kind either expressed or implied.
-}

module HigherOrderedFct
where

import Prelude hiding ( map
                      , filter
                      , any
                      , all
                      , takeWhile
                      , dropWhile
                      , sum
                      , product
                      , or
                      , and
                      , concat
                      , reverse
                      , foldl
                      , foldr
                      , flip
                      , id
                      , (.)
                      )

twice           :: (a -> a) -> a -> a
twice f x       = f (f x)

map             :: (a -> b) -> [a] -> [b]
map f xs        = [f x | x <- xs]


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


filter          :: (a -> Bool) -> [a] -> [a]
filter p xs     = [x | x <- xs, p x]


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


all            :: (a -> Bool) -> [a] -> Bool
all p []       = True
all p (x : xs) = p x && all p xs


any            :: (a -> Bool) -> [a] -> Bool
any p []       = False
any p (x : xs) = p x || any p xs


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 (x : xs)
    | p x       = dropWhile p xs
    | otherwise = x : xs

-- foldr

sum             :: Num a => [a] -> a
sum []          = 0
sum (x : xs)    = x + sum xs

product         :: Num a => [a] -> a
product []      = 1
product (x : xs)
                = x * product xs

or              :: [Bool] -> Bool
or []           = False
or (x : xs)     = x || or xs

and             :: [Bool] -> Bool
and []          = True
and (x : xs)    = x && and xs

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

reverse         :: [a] -> [a]
reverse []      = []
reverse (x : xs)= reverse xs ++ [x]

sumR            :: Num a => [a] -> a
sumR            = foldr (+)  0

productR        :: Num a => [a] -> a
productR        = foldr (*)  1

orR             :: [Bool] -> Bool
orR             = foldr (||) False

andR            :: [Bool] -> Bool
andR            = foldr (&&) True

concatR         :: [[a]] -> [a]
concatR         = foldr (++) []


foldr           :: (a -> b -> b) -> b -> [a] -> b
foldr op c []   = c
foldr op c (x : xs)
                = x `op` foldr op c xs

lengthR         :: [a] -> Integer
lengthR         = foldr (\ x n -> 1 + n) 0

reverseR        :: [a] -> [a]
reverseR        = foldr (\ x xs -> xs ++ [x]) []

mapR            :: (a -> b) -> [a] -> [b]
mapR f          = foldr (\ x xs -> f x : xs) []

filterR         :: (a -> Bool) -> [a] -> [a]
filterR p       = foldr (\ x xs -> if p x
                                   then x : xs
                                   else xs
                  ) []

suml            :: Num a => [a] -> a
suml            = sum' 0
    where
      sum' acc []       = acc
      sum' acc (x : xs) = sum' (acc + x) xs

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

foldl               :: (b -> a -> b) -> b -> [a] -> b
foldl op acc []     = acc
foldl op acc (x:xs) = foldl op (acc `op` x) xs

sumL            :: Num a => [a] -> a
sumL            = foldl (+)  0

productL        :: Num a => [a] -> a
productL        = foldl (*)  1

orL             :: [Bool] -> Bool
orL             = foldl (||) False

andL            :: [Bool] -> Bool
andL            = foldl (&&) True

concatL         :: [[a]] -> [a]
concatL         = foldl (++) []

lengthL         :: [b] -> Integer
lengthL         = foldl (\ r x -> r + 1) 0

reverseL        :: [a] -> [a]
reverseL        = foldl (\ r x -> x : r) []

-- ghci: :set +s

t1 = length (reverseR [1..10000])
t2 = length (reverseL [1..10000])
t3 = length (concatR (replicate 10000 "a"))
t4 = length (concatL (replicate 10000 "a"))

infixr 9 .

(.) :: (b -> c) -> (a -> b) -> (a -> c)
f . g = \ x -> f (g x)

id :: a -> a
id = \ x -> x

compose :: [a -> a] -> (a -> a)
compose = foldr (.) id

(>>>) :: (a -> b) -> (b -> c) -> (a -> c)
(>>>) = flip (.)

composeL :: [a -> a] -> (a -> a)
composeL = foldl (>>>) id

flip :: (a -> b -> c) -> (b -> a -> c)
flip op = \ y x -> x `op` y

fs :: [Integer -> Integer]
fs = [(+1), (*2), (`div` 3), (^2)]

r1 = compose  fs 5
r2 = composeL fs 5