-- | Higher Order Functions
-- Examples to introduce and illustrate the power of higher order functions
-- Functional Programming course 2016.
-- Thomas Hallgren

{-
This is just a skeleton, the definitions will be filled in
during the lecture.
-}


import Prelude hiding (map,filter,sum,product,concat,foldr,
                       takeWhile,dropWhile,lines)
import Data.Char(isSpace)
import Data.List(sort,group)

-- * First some examples of first order functions on lists

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

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

-- * Factor out the differences from the common pattern

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

sum' xs = foldr (+) 0 xs
product' xs = foldr (*) 1 xs
concat' xss = foldr (++) [] xss

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

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



-- * Can we rewrite map & filter too with foldr?

-- Yes, but is the code shorter and more readable than
-- when defining them directly with recursion as above?

map' f xs = foldr op [] xs
  where
    op x ys = f x:ys

filter' p xs = foldr op [] xs
  where
    op x ys | p x       = x:ys
            | otherwise = ys

-- * More examples

takeLine [] = []
takeLine ('\n':cs) = []
takeLine (c:cs) = c:takeLine cs


takeWord [] = []
takeWord (c:cs) | not (isSpace c) = c:takeWord cs
                | otherwise = []

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


takeLine' s = takeWhile (/='\n') s
takeWord' s = takeWhile (not . isSpace) s

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

dropLine s = dropWhile (/='\n') s

lines :: String -> [String]
lines [] = []
lines s  = takeLine s:lines (drop 1 (dropLine s))

segments :: (a->Bool) -> [a] -> [[a]]
segments p [] = []
segments p xs = takeWhile p xs:segments p (drop 1 (dropWhile p xs))


-- * A larger example: counting words in a string
-- and produce nicely formatted output,
-- written in "point-free style"

countWords :: String -> String
countWords = unlines .
             map (\(n,w)->w++": "++show n) .
             reverse .
             sort .
             map (\ws->(length ws,head ws)) .
             group .
             sort .
             words


{- Examples of tail recursion

-- Tail recursive
last [x] = x
last (x:xs) = last xs

-- Not tail recursive
length [] = 0
length (x:xs) = 1 + length xs

-- Tail recursive
length xs = len 0 xs
  where
    len n [] = n
    len n (x:xs) = len (n+1) xs

-}