------------------------------------------------------------------------------
--
--  Haskell: The Craft of Functional Programming, 3e
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
-- 
--  Chapter 10
--
-------------------------------------------------------------------------

-- Generalization: patterns of computation
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

module Chapter10 where

import Prelude hiding (map,filter,zipWith,foldr1,foldr,concat,and)
import Pictures hiding (flipV,beside)
import qualified Chapter7 

-- Higher-order functions: functions as arguments
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Mapping a function along a list.
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

map,map' :: (a -> b) -> [a] -> [b]

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

map :: forall a b. (a -> b) -> [a] -> [b]
map a -> b
f []     = []                   -- (map.1)
map a -> b
f (a
x:[a]
xs) = a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs               -- (map.2)

-- Examples using map.

-- Double all the elements of a list ...

doubleAll :: [Integer] -> [Integer]

doubleAll :: [Integer] -> [Integer]
doubleAll [Integer]
xs = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Integer
forall {a}. Num a => a -> a
double [Integer]
xs           
           where    
           double :: a -> a
double a
x = a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
x
 
-- ... convert characters to their numeric codes ...

convertChrs :: [Char] -> [Int]
convertChrs :: [Char] -> [Int]
convertChrs [Char]
xs = (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
forall a. Enum a => a -> Int
fromEnum [Char]
xs

-- ... flip a Picture in a vertical mirror.

flipV :: Picture -> Picture
flipV :: Picture -> Picture
flipV Picture
xs = ([Char] -> [Char]) -> Picture -> Picture
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
forall a. [a] -> [a]
reverse Picture
xs


-- Modelling properties as functions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Is an integer even?

isEven :: Integer -> Bool
isEven :: Integer -> Bool
isEven Integer
n = (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)

-- Is a list sorted?

isSorted :: [Integer] -> Bool
isSorted :: [Integer] -> Bool
isSorted [Integer]
xs = ([Integer]
xs [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer] -> [Integer]
iSort [Integer]
xs)


-- Filtering -- the filter function
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

filter :: (a -> Bool) -> [a] -> [a]

filter :: forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [] = []                -- (filter.1)
filter a -> Bool
p (a
x:[a]
xs)
  | a -> Bool
p a
x         = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs       -- (filter.2)
  | Bool
otherwise   =     (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs       -- (filter.3)

-- A list comprehension also serves to define filter,

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


-- Combining zip and map -- the zipWith function
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]

zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f [a]
xs [b]
ys
zipWith a -> b -> c
f  [a]
_      [b]
_     = []

beside :: Picture -> Picture -> Picture
beside :: Picture -> Picture -> Picture
beside Picture
pic1 Picture
pic2 = ([Char] -> [Char] -> [Char]) -> Picture -> Picture -> Picture
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) Picture
pic1 Picture
pic2


-- Folding and primitive recursion
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Folding an operation into a non-empty list

foldr1 :: (a -> a -> a) -> [a] -> a

foldr1 :: forall a. (a -> a -> a) -> [a] -> a
foldr1 a -> a -> a
f [a
x]    = a
x             -- (foldr1.1)
foldr1 a -> a -> a
f (a
x:[a]
xs) = a -> a -> a
f a
x ((a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldr1 a -> a -> a
f [a]
xs)     -- (foldr1.2)

-- Examples using foldr1

foldEx1 :: Integer
foldEx1 = (Integer -> Integer -> Integer) -> [Integer] -> Integer
forall a. (a -> a -> a) -> [a] -> a
foldr1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [Integer
3,Integer
98,Integer
1]
foldEx2 :: Bool
foldEx2 = (Bool -> Bool -> Bool) -> [Bool] -> Bool
forall a. (a -> a -> a) -> [a] -> a
foldr1 Bool -> Bool -> Bool
(||) [Bool
False,Bool
True,Bool
False]
foldEx3 :: [Char]
foldEx3 = ([Char] -> [Char] -> [Char]) -> Picture -> [Char]
forall a. (a -> a -> a) -> [a] -> a
foldr1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) [[Char]
"Freak ", [Char]
"Out" , [Char]
"", [Char]
"!"] 
foldEx4 :: Integer
foldEx4 = (Integer -> Integer -> Integer) -> [Integer] -> Integer
forall a. (a -> a -> a) -> [a] -> a
foldr1 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min [Integer
6]
foldEx5 :: Integer
foldEx5 = (Integer -> Integer -> Integer) -> [Integer] -> Integer
forall a. (a -> a -> a) -> [a] -> a
foldr1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) [Integer
1 .. Integer
6]

-- Folding into an arbitrary list: using a starting value on the empty list.

foldr :: forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> b -> b
f b
s []     = b
s                -- (foldr.1)
foldr a -> b -> b
f b
s (a
x:[a]
xs) = a -> b -> b
f a
x ((a -> b -> b) -> b -> [a] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> b -> b
f b
s [a]
xs)       -- (foldr.2)

-- Concatenating a list using foldr.

concat :: [[a]] -> [a]
concat :: forall a. [[a]] -> [a]
concat [[a]]
xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [] [[a]]
xs

-- Conjoining a list of Bool using foldr.

and :: [Bool] -> Bool
and :: [Bool] -> Bool
and [Bool]
bs = (Bool -> Bool -> Bool) -> Bool -> [Bool] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Bool -> Bool -> Bool
(&&) Bool
True [Bool]
bs

-- Can define foldr1 using foldr:
--  foldr1 f (x:xs) = foldr f x xs          -- (foldr1.0)


-- Folding in general -- foldr again
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- The type of foldr is more general than you would initially expect...

foldr :: (a -> b -> b) -> b -> [a] -> b

rev :: [a] -> [a]
rev :: forall a. [a] -> [a]
rev [a]
xs = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> [a] -> [a]
forall a. a -> [a] -> [a]
snoc [] [a]
xs

snoc :: a -> [a] -> [a]
snoc :: forall a. a -> [a] -> [a]
snoc a
x [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]

-- Sorting a list using foldr

iSort :: [Integer] -> [Integer]
iSort :: [Integer] -> [Integer]
iSort [Integer]
xs = (Integer -> [Integer] -> [Integer])
-> [Integer] -> [Integer] -> [Integer]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr Integer -> [Integer] -> [Integer]
Chapter7.ins [] [Integer]
xs

-- From the exercises: a mystery function ...

mystery :: [a] -> [a]
mystery [a]
xs = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [] ((a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall {a}. a -> [a]
sing [a]
xs)
sing :: a -> [a]
sing a
x     = [a
x]


-- Generalizing: splitting up lists
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Getting the first word from the front of a String ...

getWord :: String -> String
getWord :: [Char] -> [Char]
getWord []    = []                  -- (getWord.1)
getWord (Char
x:[Char]
xs) 
  | Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
x [Char]
Chapter7.whitespace  = []            -- (getWord.2)
  | Bool
otherwise               = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
getWord [Char]
xs    -- (getWord.3)

-- ... which generalizes to a function which gets items from the front of a list
-- until an item has the required property.

getUntil :: (a -> Bool) -> [a] -> [a]
getUntil :: forall a. (a -> Bool) -> [a] -> [a]
getUntil a -> Bool
p []    = [] 
getUntil a -> Bool
p (a
x:[a]
xs) 
  | a -> Bool
p a
x         = []
  | Bool
otherwise   = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
getUntil a -> Bool
p [a]
xs

-- The original getWord function defined from getUntil

--  getWord xs 
--    = getUntil p xs
--      where 
--      p x = elem x whitespace