module L04A where
-- Examples from Lecture 4A
-- 2010-11-17
import Prelude hiding () -- might hide some defs

import Test.QuickCheck
import Text.Show.Functions     
  -- needed to test higher-order functions

import Data.Char(isSpace,toUpper)      
  -- useful character tests and conversions
import Data.List(sort,group,groupBy)
  -- handy list functions not in Prelude
------------------------------------------




-- map

-- filter

-- The foldr pattern

-- sum, product, concatenate
sum' []     = 0
sum' (x:xs) = x + sum' xs

product' []     = 1 
product' (x:xs) = x * product' xs

concat' []       = []
concat' (xs:xss) = xs ++ concat' xss

foldr' f b []     = b
foldr' f b (x:xs) = x `f` foldr' f b xs

-- xs ++ ys = foldr (:) ys xs


-- Side note: operators and functions

q1 ys    = foldr (:) ys []  -- identity on lists
q2 xs ys = foldr (:) ys xs  -- xs ++ ys

q3 xs    = foldr snoc [] xs
    where snoc y ys = ys ++ [y]

q3' xs   = foldr (\y ys -> ys ++ [y]) [] xs

shout :: [String] -> [String]

shout xss = map (map toUpper) xss
 --           (\s -> map toUpper s)
      --      where sh s = map toUpper s

-- unlines
unlines' xs = foldr (\xs ys -> xs ++ "\n" ++ ys) [] xs

------------------------------------

-- Another useful pattern. 
-- e.g. takeLine

takeLine [] = []
takeLine (x:xs) | x /= '\n' = x:takeLine xs
                | otherwise = []

takeWord [] = []
takeWord (x:xs) | not(isSpace x) = x : takeWord xs
                | otherwise      = []

takeWhile' p [] = []
takeWhile' p (x:xs) | p x       = x : takeWhile' p xs
                    | otherwise = []


-- Side note: sections

-- takeWhile &  dropWhile

------------------------------------
-- Another example (lines)

lines' [] = []
lines' xs = takeWhile (/= '\n') xs : 
             lines' (drop 1 (dropWhile (/= '\n') xs))

-- Generalise: segments (not a standard function)

-- words using isSpace
segments p [] = []
segments p  xs = takeWhile p xs : 
             segments p (drop 1 (dropWhile p xs))


-------------------------------------
-- More ways to build functions: Partial application 

-- sum, revisited
f :: Int -> Bool -> String -> String
f i b s = take i (show (not b) ++ s)

-- (slides: bracketing)
-- Lecture 4A, 2010 got to here....

-- Fixity.  How do you know when to skip brackets?
-- $
 
------------------------------------
-- Another way to build functions: function composition 
-- 


countWords :: String -> String -- count words in a string
countWords = unlines
           . map (\(s,n) -> s ++ ": " ++ show n)
           . map (\s -> (head s,length s))
           . groupBy (==)
           . sort
           . words

prop_mapmap f g x =  (map f . map g) x ==  map (f . g) x 
-- groupBy (group)