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

module Chapter7 where

-- Defining functions over lists
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- For pedagogical reasons, this chapter repeats many of the definitions in the
-- standard Prelude. They are repeated in this file, and so the original
-- definitions have to be hidden when the Prelude is imported:

import Prelude hiding (Word,id,head,tail,null,sum,concat,(++),zip,take,getLine)
import qualified Prelude

import Chapter5 (digits,isEven) 
import Test.QuickCheck

-- Pattern matching revisited
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^

-- An example function using guards ...

mystery :: Integer -> Integer -> Integer
mystery :: Integer -> Integer -> Integer
mystery Integer
x Integer
y 
  | Integer
xInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0        = Integer
y
  | Bool
otherwise   = Integer
x

--  ... or pattern matching

mystery' :: Integer -> Integer -> Integer
mystery' :: Integer -> Integer -> Integer
mystery' Integer
0 Integer
y = Integer
y
mystery' Integer
x Integer
_ = Integer
x

-- To join two strings

joinStrings :: (String,String) -> String
joinStrings :: (String, String) -> String
joinStrings (String
st1,String
st2) = String
st1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
st2


-- Lists and list patterns
-- ^^^^^^^^^^^^^^^^^^^^^^^
-- From the Prelude ...

head             :: [a] -> a
head :: forall a. [a] -> a
head (a
x:[a]
_)        = a
x

tail             :: [a] -> [a]
tail :: forall a. [a] -> [a]
tail (a
_:[a]
xs)       = [a]
xs

null             :: [a] -> Bool
null :: forall a. [a] -> Bool
null []           = Bool
True
null (a
_:[a]
_)        = Bool
False


-- The case construction
-- ^^^^^^^^^^^^^^^^^^^^^

-- Return the first digit in a string.

firstDigit :: String -> Char

firstDigit :: String -> Char
firstDigit String
st 
  = case (String -> String
digits String
st) of
      []    -> Char
'\0'
      (Char
x:String
_) -> Char
x


-- Primitive recursion over lists
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- The sum of a list of Ints.

sum :: [Integer] -> Integer

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

-- Property to test the re-implementation of sum
-- against the version in the prelude.

prop_sum :: [Integer] -> Bool

prop_sum :: [Integer] -> Bool
prop_sum [Integer]
xs =  [Integer] -> Integer
sum [Integer]
xs Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Prelude.sum [Integer]
xs

-- Finding primitive recursive definitions
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- Concatenating a list of lists.

concat :: [[a]] -> [a]

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

-- Joining two lists

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

[]     ++ :: forall a. [a] -> [a] -> [a]
++ [a]
ys = [a]
ys
(a
x:[a]
xs) ++ [a]
ys = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ys)

-- Testing whether something is a member of a list.

-- Renamed to elem' as we use the elem from Prelude
-- elsewhere in the file.

elem' :: Integer -> [Integer] -> Bool

elem' :: Integer -> [Integer] -> Bool
elem' Integer
x []     = Bool
False
elem' Integer
x (Integer
y:[Integer]
ys) = (Integer
xInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
y) Bool -> Bool -> Bool
|| (Integer -> [Integer] -> Bool
elem' Integer
x [Integer]
ys)


-- To double every element of an integer list

doubleAll :: [Integer] -> [Integer]

doubleAll :: [Integer] -> [Integer]
doubleAll [Integer]
xs = [ Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
x | Integer
x<-[Integer]
xs ]

doubleAll' :: [a] -> [a]
doubleAll' []     = []
doubleAll' (a
x:[a]
xs) = a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
doubleAll' [a]
xs

-- To select the even elements from an integer list. 

selectEven :: [Integer] -> [Integer]

selectEven :: [Integer] -> [Integer]
selectEven [Integer]
xs = [ Integer
x | Integer
x<-[Integer]
xs , Integer -> Bool
isEven Integer
x ]

selectEven' :: [Integer] -> [Integer]
selectEven' [] = []
selectEven' (Integer
x:[Integer]
xs)
  | Integer -> Bool
isEven Integer
x    = Integer
x Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer]
selectEven' [Integer]
xs
  | Bool
otherwise   =     [Integer] -> [Integer]
selectEven' [Integer]
xs

-- To sort a list of numbers into ascending order.

iSort :: [Integer] -> [Integer]

iSort :: [Integer] -> [Integer]
iSort []     = [] 
iSort (Integer
x:[Integer]
xs) = Integer -> [Integer] -> [Integer]
ins Integer
x ([Integer] -> [Integer]
iSort [Integer]
xs) 

-- To insert an element at the right place into a sorted list.

ins :: Integer -> [Integer] -> [Integer]

ins :: Integer -> [Integer] -> [Integer]
ins Integer
x []    = [Integer
x] 
ins Integer
x (Integer
y:[Integer]
ys) 
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
y      = Integer
xInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:(Integer
yInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
ys)
  | Bool
otherwise   = Integer
y Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Integer -> [Integer] -> [Integer]
ins Integer
x [Integer]
ys


-- General recursions over lists
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^


-- Zipping together two lists.

zip :: [a] -> [b] -> [(a,b)]

zip :: forall a b. [a] -> [b] -> [(a, b)]
zip (a
x:[a]
xs) (b
y:[b]
ys) = (a
x,b
y) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [b]
ys
zip (a
x:[a]
xs) []     = []
zip []     [b]
zs     = []

-- Taking a given number of elements from a list.

take :: Int -> [a] -> [a]

take :: forall a. Int -> [a] -> [a]
take Int
0 [a]
_        = []
take Int
_ []       = []
take Int
n (a
x:[a]
xs)
  | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0         = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
take Int
_ [a]
_        = String -> [a]
forall a. HasCallStack => String -> a
error String
"PreludeList.take: negative argument"

-- Quicksort over lists.

qSort :: [Integer] -> [Integer]

qSort :: [Integer] -> [Integer]
qSort [] = []
qSort (Integer
x:[Integer]
xs) 
  = [Integer] -> [Integer]
qSort [ Integer
y | Integer
y<-[Integer]
xs , Integer
yInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
x] [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer
x] [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer] -> [Integer]
qSort [ Integer
y | Integer
y<-[Integer]
xs , Integer
yInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
x]



-- Example: Text Processing
-- ^^^^^^^^^^^^^^^^^^^^^^^^

-- The `whitespace' characters.

whitespace :: String
whitespace :: String
whitespace = [Char
'\n',Char
'\t',Char
' ']

-- Get a word from the front of a string.

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

-- In a similar way, the first word of a string can be dropped.

dropWord :: String -> String
dropWord :: String -> String
dropWord []    = []
dropWord (Char
x:String
xs) 
  | Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
x String
whitespace   = (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
  | Bool
otherwise           = String -> String
dropWord String
xs

-- To remove the whitespace character(s) from the front of a string.

dropSpace :: String -> String
dropSpace :: String -> String
dropSpace []    = []
dropSpace (Char
x:String
xs) 
  | Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
x String
whitespace   = String -> String
dropSpace String
xs
  | Bool
otherwise           = (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)

-- A word is a string.

type Word = String

-- Splitting a string into words.

splitWords :: String -> [Word]
splitWords :: String -> [String]
splitWords String
st = String -> [String]
split (String -> String
dropSpace String
st)

split :: String -> [Word]
split :: String -> [String]
split [] = []
split String
st
  = (String -> String
getWord String
st) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split (String -> String
dropSpace (String -> String
dropWord String
st))

-- Splitting into lines of length at most lineLen

lineLen :: Int
lineLen :: Int
lineLen = Int
80

-- A line is a list of words.

type Line = [Word]

-- Getting a line from a list of words.

getLine :: Int -> [Word] -> Line
getLine :: Int -> [String] -> [String]
getLine Int
len []     = []
getLine Int
len (String
w:[String]
ws)
  | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len     = String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
restOfLine  
  | Bool
otherwise           = []
    where
    newlen :: Int
newlen      = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    restOfLine :: [String]
restOfLine  = Int -> [String] -> [String]
getLine Int
newlen [String]
ws

-- Dropping the first line from a list of words.

dropLine :: Int -> [Word] -> Line

dropLine :: Int -> [String] -> [String]
dropLine = Int -> [String] -> [String]
dropLine     -- DUMMY DEFINITION

-- Splitting into lines.

splitLines :: [Word] -> [Line]
splitLines :: [String] -> [[String]]
splitLines [] = []
splitLines [String]
ws
  = Int -> [String] -> [String]
getLine Int
lineLen [String]
ws
         [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [String] -> [[String]]
splitLines (Int -> [String] -> [String]
dropLine Int
lineLen [String]
ws)

-- To fill a text string into lines, we write

fill :: String -> [Line]
fill :: String -> [[String]]
fill = [String] -> [[String]]
splitLines ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitWords