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



-- Functions as values
-- ^^^^^^^^^^^^^^^^^^^

module Chapter11 where

import Prelude hiding (succ,curry,uncurry,flip)
import Chapter10 (getUntil) 
import Chapter7 (whitespace) 
import Test.QuickCheck

-- A fixity declaration for the forward composition operator, >.>

infixl 9 >.>


-- Function composition and forward composition
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- A composition operator taking its arguments in the opposite order to `.'.


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

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


-- Expressions for functions: lambda abstractions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

addOnes :: [Integer]

addOnes :: [Integer]
addOnes = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) [Integer
2,Integer
3,Integer
4]


-- Mapping a list of functions onto a value

mapFuns :: [a->b] -> a -> [b]

mapFuns :: forall a b. [a -> b] -> a -> [b]
mapFuns [] a
x     = []
mapFuns (a -> b
f:[a -> b]
fs) a
x = a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a -> b] -> a -> [b]
forall a b. [a -> b] -> a -> [b]
mapFuns [a -> b]
fs a
x

-- Two alternative definitions

mapFuns1 :: [t -> b] -> t -> [b]
mapFuns1 [t -> b]
fs t
x = ((t -> b) -> b) -> [t -> b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\t -> b
f -> t -> b
f t
x) [t -> b]
fs

mapFuns2 :: [p -> b] -> p -> [b]
mapFuns2 [p -> b]
fs p
x = ((p -> b) -> b) -> [p -> b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (p -> b) -> b
forall {t}. (p -> t) -> t
applyToX [p -> b]
fs
               where
               applyToX :: (p -> t) -> t
applyToX p -> t
f = p -> t
f p
x

-- A function returning a function, namely the function to `add n to its
-- argument'.

addNum :: Integer -> (Integer -> Integer)

addNum :: Integer -> Integer -> Integer
addNum Integer
n = (\Integer
m -> Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
m)

-- The `plumbing' function:

comp2 :: (a -> b) -> (b -> b -> c) -> (a -> a -> c)

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

-- Using the `plumbing' function

plumbingExample :: Integer
plumbingExample = (Integer -> Integer)
-> (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b) -> (b -> b -> c) -> a -> a -> c
comp2 Integer -> Integer
forall {a}. Num a => a -> a
sq Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
add Integer
3 Integer
4
          where
          sq :: a -> a
sq a
x    = a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
x
          add :: a -> a -> a
add a
y a
z = a
ya -> a -> a
forall a. Num a => a -> a -> a
+a
z

 
-- Partial Application
-- ^^^^^^^^^^^^^^^^^^^

-- The function multiply multiplies together two arguments.

multiply :: Int -> Int -> Int
multiply :: Int -> Int -> Int
multiply Int
x Int
y = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y

-- Double all elements of an integer list.

doubleAll :: [Int] -> [Int]
doubleAll :: [Int] -> [Int]
doubleAll = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
multiply Int
2)

-- Another definition of addNum, using partial application to achieve the
-- `function as result'.

addNum' :: a -> a -> a
addNum' a
n a
m = a
na -> a -> a
forall a. Num a => a -> a -> a
+a
m

-- Operator  Sections

-- Example of a function defined using partial application and operator sections.

egFun :: [Int] -> [Int]

egFun :: [Int] -> [Int]
egFun = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)



-- Three examples from the text processing functions first seen in Chapter 7.

dropSpace :: [Char] -> [Char]
dropSpace = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ([Char] -> Char -> Bool
forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> a -> Bool
member [Char]
whitespace)
dropWord :: [Char] -> [Char]
dropWord  = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char -> Bool
forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> a -> Bool
member [Char]
whitespace)
getWord :: [Char] -> [Char]
getWord   = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char -> Bool
forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> a -> Bool
member [Char]
whitespace)

-- Auxiliary definitions ...
 
member :: t a -> a -> Bool
member t a
xs a
x = a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x t a
xs

-- Under the hood: curried functions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- An example function of type (Int -> Int) -> Int

g :: (Int -> Int) -> Int
g :: (Int -> Int) -> Int
g Int -> Int
h = (Int -> Int
h Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int
h Int
1)

-- Currying and uncurrying
-- ^^^^^^^^^^^^^^^^^^^^^^^

-- An uncurried function to multiply together the two itegers in a pair.

multiplyUC :: (Int,Int) -> Int
multiplyUC :: (Int, Int) -> Int
multiplyUC (Int
x,Int
y) = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y

-- Turn an uncurried function into a curried version,

curry :: ((a,b) -> c) -> (a -> b -> c)
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
g a
x b
y = (a, b) -> c
g (a
x,b
y)

-- and vice versa.

uncurry :: (a -> b -> c) -> ((a,b) -> c)
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f (a
x,b
y) = a -> b -> c
f a
x b
y

-- Zip property

prop_zip :: [(Integer, Integer)] -> Bool
prop_zip :: [(Integer, Integer)] -> Bool
prop_zip [(Integer, Integer)]
xs = ([Integer] -> [Integer] -> [(Integer, Integer)])
-> ([Integer], [Integer]) -> [(Integer, Integer)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(Integer, Integer)] -> ([Integer], [Integer])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Integer, Integer)]
xs) [(Integer, Integer)] -> [(Integer, Integer)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Integer, Integer)]
xs

-- Defining higher-order functions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Using the operators

-- Compose a function with itself: apply it twice, in other words.

twice :: (a -> a) -> (a -> a)
twice :: forall a. (a -> a) -> a -> a
twice a -> a
f = (a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)

succ :: Int -> Int
succ :: Int -> Int
succ Int
n = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1

-- We can generalize twice so that we pass a parameter giving the number
-- of times the functional argument is to be composed with itself:

iter :: Int -> (a -> a) -> (a -> a)

iter :: forall a. Int -> (a -> a) -> a -> a
iter Int
n a -> a
f 
  | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0         = a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (a -> a) -> a -> a
forall a. Int -> (a -> a) -> a -> a
iter (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a -> a
f
  | Bool
otherwise   = a -> a
forall a. a -> a
id

-- An alternative definition of iter:

iter' :: Int -> (b -> b) -> b -> b
iter' Int
n b -> b
f = ((b -> b) -> (b -> b) -> b -> b) -> (b -> b) -> [b -> b] -> b -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. a -> a
id (Int -> (b -> b) -> [b -> b]
forall a. Int -> a -> [a]
replicate Int
n b -> b
f)

-- Using local definitions

addNum2 :: Integer -> Integer -> Integer

addNum2 :: Integer -> Integer -> Integer
addNum2 Integer
n = Integer -> Integer
addN
           where
           addN :: Integer -> Integer
addN Integer
m = Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
m

addNum3 :: p -> p -> p
addNum3 p
n = let 
             addN :: p -> p
addN p
m = p
np -> p -> p
forall a. Num a => a -> a -> a
+p
m
           in
             p -> p
addN

-- Lambda abstractions

flip' :: (a -> b -> c) -> (b -> a -> c)
flip' :: forall a b c. (a -> b -> c) -> b -> a -> c
flip' a -> b -> c
f = \b
x a
y -> a -> b -> c
f a
y b
x

-- Change the order of arguments of a two argument curried function.

flip :: (a -> b -> c) -> (b -> a -> c)
flip :: forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> c
f b
x a
y = a -> b -> c
f a
y b
x

-- Mystery function from "Point-free programming"

puzzle :: (a -> b -> c) -> a -> (a -> b) -> a -> c
puzzle = ((b -> c) -> (a -> b) -> a -> c)
-> (a -> b -> c) -> a -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

-- Final examples

-- Double all integers in a list,

doubleAll' :: [Int] -> [Int]
doubleAll' :: [Int] -> [Int]
doubleAll' = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)

-- get the even numbers in a list of integers,

getEvens :: [Int] -> [Int]
getEvens :: [Int] -> [Int]
getEvens = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)(Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2))

-- get a word from the start of a string.

getWord' :: [Char] -> [Char]
getWord' = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
getUntil (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
whitespace)
 




-- Verification and general functions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

prop_mf :: (b -> Bool) -> (a -> b) -> [a] -> Bool
prop_mf b -> Bool
p a -> b
f = 
    \[a]
xs -> ((b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter b -> Bool
p ([b] -> [b]) -> ([a] -> [b]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [a]
xs [b] -> [b] -> Bool
forall a. Eq a => a -> a -> Bool
== ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> [b]) -> ([a] -> [a]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
p (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)) [a]
xs