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

module Chapter3 where

import Prelude hiding (max)
import Test.QuickCheck 

-- The import statement which follows hides certain of the Prelude functions
-- so that they can be given the definitions they have in their book.


-- The Booleans.
-- ^^^^^^^^^^^^^

-- Exclusive or: this gives the result True if one of its arguments is True and
-- the other False, and gives the result False in other cases.

exOr :: Bool -> Bool -> Bool
exOr :: Bool -> Bool -> Bool
exOr Bool
x Bool
y = (Bool
x Bool -> Bool -> Bool
|| Bool
y) Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
x Bool -> Bool -> Bool
&& Bool
y)

-- Using literals instead of variables in a definition; a simple example of
-- pattern matching to give another definition of `not', ...

myNot :: Bool -> Bool
myNot :: Bool -> Bool
myNot Bool
True  = Bool
False
myNot Bool
False = Bool
True

prop_myNot :: Bool -> Bool

prop_myNot :: Bool -> Bool
prop_myNot Bool
x =
    Bool -> Bool
not Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool
myNot Bool
x

-- ... and of `exclusive or'.

exOr1 :: Bool -> Bool -> Bool
exOr1 Bool
True  Bool
x = Bool -> Bool
not Bool
x
exOr1 Bool
False Bool
x = Bool
x

-- Test exOrs

prop_exOrs :: Bool -> Bool -> Bool

prop_exOrs :: Bool -> Bool -> Bool
prop_exOrs Bool
x Bool
y =
    Bool -> Bool -> Bool
exOr Bool
x Bool
y Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Bool -> Bool
exOr1 Bool
x Bool
y

prop_exOr2 :: Bool -> Bool -> Bool

prop_exOr2 :: Bool -> Bool -> Bool
prop_exOr2 Bool
x Bool
y =
    Bool -> Bool -> Bool
exOr Bool
x Bool
y Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
y)

-- Integers and guards.
-- ^^^^^^^^^^^^^^^^^^^^

-- A to test whether three Ints are equal.

threeEqual :: Integer -> Integer -> Integer -> Bool
threeEqual :: Integer -> Integer -> Integer -> Bool
threeEqual Integer
m Integer
n Integer
p = (Integer
mInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
n) Bool -> Bool -> Bool
&& (Integer
nInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
p)

-- The maximum of two integers; this is already defined in the Prelude, 
-- so its definition is hidden by the import statement at the top of this file.

max :: Integer -> Integer -> Integer
max :: Integer -> Integer -> Integer
max Integer
x Integer
y
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y      = Integer
x
  | Bool
otherwise   = Integer
y

-- The maximum of three integers.

maxThree :: Integer -> Integer -> Integer -> Integer
maxThree :: Integer -> Integer -> Integer -> Integer
maxThree Integer
x Integer
y Integer
z
  | (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y) Bool -> Bool -> Bool
&& (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
z)    = Integer
x
  | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
z                  = Integer
y
  | Bool
otherwise               = Integer
z

-- An alternative definition of max which uses if ... then ... else ...

max' :: Integer -> Integer -> Integer
max' :: Integer -> Integer -> Integer
max' Integer
x Integer
y
  = if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
y then Integer
x else Integer
y

prop_compareMax :: Integer -> Integer -> Bool
prop_compareMax :: Integer -> Integer -> Bool
prop_compareMax Integer
x Integer
y =
    Integer -> Integer -> Integer
max Integer
x Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
max' Integer
x Integer
y

prop_max1, prop_max2, prop_max3 :: Integer -> Integer -> Bool

prop_max1 :: Integer -> Integer -> Bool
prop_max1 Integer
x Integer
y =
    Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer -> Integer -> Integer
max Integer
x Integer
y Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer -> Integer -> Integer
max Integer
x Integer
y

prop_max2 :: Integer -> Integer -> Bool
prop_max2 Integer
x Integer
y =
    Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
max Integer
x Integer
y Bool -> Bool -> Bool
|| Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
max Integer
x Integer
y

prop_max3 :: Integer -> Integer -> Bool
prop_max3 Integer
x Integer
y =
    (Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
max Integer
x Integer
y) Bool -> Bool -> Bool
`exOr` (Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> Integer
max Integer
x Integer
y)


-- Characters.
-- ^^^^^^^^^^^

-- Converting lower-case letters to upper-case; does something odd if you apply
-- it to anythig else: how would you modify it to return anything else
-- unchanged?
 
toUpper :: Char -> Char
toUpper :: Char -> Char
toUpper Char
ch = Int -> Char
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
ch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)

offset :: Int
offset = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a'

-- A check whether a character is a digit.

isDigit :: Char -> Bool
isDigit :: Char -> Bool
isDigit Char
ch = (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
ch) Bool -> Bool -> Bool
&& (Char
ch Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')


-- The String type
-- ^^^^^^^^^^^^^^^

-- Example strings

str1, str2, str3, str4, str5 :: String

str1 :: String
str1 = String
"baboon"
str2 :: String
str2 = String
""
str3 :: String
str3 = String
"\99a\116"
str4 :: String
str4 = String
"gorilla\nhippo\nibex"
str5 :: String
str5 = String
"1\t23\t456"

pstr1, pstr2, pstr3, pstr4, pstr5 :: IO ()

pstr1 :: IO ()
pstr1 = String -> IO ()
putStr String
str1
pstr2 :: IO ()
pstr2 = String -> IO ()
putStr String
str2
pstr3 :: IO ()
pstr3 = String -> IO ()
putStr String
str3
pstr4 :: IO ()
pstr4 = String -> IO ()
putStr String
str4
pstr5 :: IO ()
pstr5 = String -> IO ()
putStr String
str5



-- Some syntax.
-- ^^^^^^^^^^^^

-- Layout: two definitions on one line, separated by a `;'.

answer :: Integer
answer = Integer
42 ;   facSix :: Integer
facSix = Integer
720 

-- Adding two integers: you can use longer names for variables than x and y!

addTwo :: Integer -> Integer -> Integer
addTwo :: Integer -> Integer -> Integer
addTwo Integer
first Integer
second = Integer
firstInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
second

-- Defining an operator for yourself: another version of max!

(&&&) :: Integer -> Integer -> Integer
Integer
x &&& :: Integer -> Integer -> Integer
&&& Integer
y 
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
y       = Integer
y
  | Bool
otherwise   = Integer
x