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

module Chapter13 where

import Data.List
import Chapter5 (Shape(..),area)

-- Overloading and type classes
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Why overloading?
-- ^^^^^^^^^^^^^^^^

-- Testing for membership of a Boolean list.

elemBool :: Bool -> [Bool] -> Bool

elemBool :: Bool -> [Bool] -> Bool
elemBool Bool
x [] = Bool
False
elemBool Bool
x (Bool
y:[Bool]
ys)
  = (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y) Bool -> Bool -> Bool
|| Bool -> [Bool] -> Bool
elemBool Bool
x [Bool]
ys

-- Testing for membership of a general list, with the equality function as a
-- parameter.

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

elemGen :: forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemGen a -> a -> Bool
eqFun a
x [] = Bool
False
elemGen a -> a -> Bool
eqFun a
x (a
y:[a]
ys)
  = (a -> a -> Bool
eqFun a
x a
y) Bool -> Bool -> Bool
|| (a -> a -> Bool) -> a -> [a] -> Bool
forall a. (a -> a -> Bool) -> a -> [a] -> Bool
elemGen a -> a -> Bool
eqFun a
x [a]
ys


-- Introducing classes
-- ^^^^^^^^^^^^^^^^^^^

-- Definitions of classes cannot be hidden, so the definitions etc. here are not
-- executable.

-- class Eq a where
--   (==) :: a -> a -> Bool

-- Functions which use equality
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- Testing for three values equal: more general than Int -> Int -> Int -> Bool.

allEqual :: Eq a => a -> a -> a -> Bool
allEqual :: forall a. Eq a => a -> a -> a -> Bool
allEqual a
m a
n a
p = (a
ma -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
n) Bool -> Bool -> Bool
&& (a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
p)

-- Erroneous expression

-- error1 = allEqual suc suc suc

suc :: Integer -> Integer
suc = (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)

-- elem :: Eq a => a -> [a] -> Bool
-- books :: Eq a => [ (a,b) ] -> a -> [b]

-- It is easier to see this typing if you remane books lookupFirst:

lookupFirst :: Eq a => [ (a,b) ] -> a -> [b]

lookupFirst :: forall a b. Eq a => [(a, b)] -> a -> [b]
lookupFirst [(a, b)]
ws a
x 
  = [ b
z | (a
y,b
z) <- [(a, b)]
ws , a
ya -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x ]

-- borrowed    :: Eq b => [ (a,b) ] -> b -> Bool
-- numBorrowed :: Eq a => [ (a,b) ] -> a -> Int


-- Signatures and Instances
-- ^^^^^^^^^^^^^^^^^^^^^^^^

-- A type is made a member or instance of a class by defining
-- the signature functions for the type. For example,

-- instance Eq Bool where
--   True  == True  = True
--   False == False = True
--   _     == _     = False

-- The Info class:

class Info a where
  examples :: [a]
  size     :: a -> Int
  size a
_   = Int
1

-- Declaring instances of the Info class


instance Info Int where
  examples :: [Int]
examples = [-Int
100..Int
100]
   --size _   = 1

instance Info Char where
  examples :: [Char]
examples = [Char
'a',Char
'A',Char
'z',Char
'Z',Char
'0',Char
'9']
  -- size _   = 1

instance Info Bool where
  examples :: [Bool]
examples = [Bool
True,Bool
False]
  -- size _   = 1

-- An instance declaration for a data type.

instance Info Shape where
  examples :: [Shape]
examples = [ Float -> Shape
Circle Float
3.0, Float -> Float -> Shape
Rectangle Float
45.9 Float
87.6 ]
  size :: Shape -> Int
size     = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> (Shape -> Float) -> Shape -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> Float
area


-- Instance declaration with contexts.

instance Info a => Info [a] where
  examples :: [[a]]
examples = [ [] ] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ [a
x] | a
x<-[a]
forall a. Info a => [a]
examples ] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ [a
x,a
y] | a
x<-[a]
forall a. Info a => [a]
examples , a
y<-[a]
forall a. Info a => [a]
examples ]
  size :: [a] -> Int
size     = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1 ([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. Info a => a -> Int
size  

instance (Info a,Info b) => Info (a,b) where
  examples :: [(a, b)]
examples   = [ (a
x,b
y) | a
x<-[a]
forall a. Info a => [a]
examples , b
y<-[b]
forall a. Info a => [a]
examples ]
  size :: (a, b) -> Int
size (a
x,b
y) = a -> Int
forall a. Info a => a -> Int
size a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall a. Info a => a -> Int
size b
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 


-- Default definitions
-- ^^^^^^^^^^^^^^^^^^^

-- To return to our example of equality, the Haskell equality class is in fact
-- defined by

-- class Eq a where
--   (==), (/=) :: a -> a -> Bool
--   x /= y     = not (x==y)
--   x == y     = not (x/=y)


-- Derived classes
-- ^^^^^^^^^^^^^^^

-- Ordering is built on Eq.

-- class Eq a => Ord a where
--   (<), (<=), (>), (>=) :: a -> a -> Bool
--   max, min             :: a -> a -> a
--   compare              :: a -> a -> Ordering


-- This is the same definition as in Chapter7, but now with an overloaded type.

iSort :: Ord a => [a] -> [a]

iSort :: forall a. Ord a => [a] -> [a]
iSort []    = []
iSort (a
x:[a]
xs) = a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
ins a
x ([a] -> [a]
forall a. Ord a => [a] -> [a]
iSort [a]
xs)

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

ins :: Ord a => a -> [a] -> [a]

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


-- Multiple constraints
-- ^^^^^^^^^^^^^^^^^^^^

-- Sorting visible objects ...

vSort :: (Ord a,Show a) => [a] -> String

vSort :: forall a. (Ord a, Show a) => [a] -> [Char]
vSort = [a] -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> [Char]) -> ([a] -> [a]) -> [a] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
iSort 

-- Similarly, 

vLookupFirst :: (Eq a,Show b) => [(a,b)] -> a -> String

vLookupFirst :: forall a b. (Eq a, Show b) => [(a, b)] -> a -> [Char]
vLookupFirst [(a, b)]
xs a
x = [b] -> [Char]
forall a. Show a => a -> [Char]
show ([(a, b)] -> a -> [b]
forall a b. Eq a => [(a, b)] -> a -> [b]
lookupFirst [(a, b)]
xs a
x)

-- Multiple constraints can occur in an instance declaration, such as

-- instance (Eq a,Eq b) => Eq (a,b) where
--   (x,y) == (z,w)  =  x==z && y==w

-- Multiple constraints can also occur in the definition of a class,

class (Ord a,Show a) => OrdVis a

-- Can then give vSort the type:

--  vSort :: OrdVis a => [a] -> String

-- InfoCheck. Check a property for all examples

-- infoCheck :: (Info a) => (a -> Bool) -> Bool

-- infoCheck property = and (map property examples)

class Checkable b where
 infoCheck :: (Info a) => (a -> b) -> Bool

instance Checkable Bool where
  infoCheck :: forall a. Info a => (a -> Bool) -> Bool
infoCheck a -> Bool
property = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((a -> Bool) -> [a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map a -> Bool
property [a]
forall a. Info a => [a]
examples)  

instance (Info a, Checkable b) => Checkable (a -> b) where
  infoCheck :: forall a. Info a => (a -> a -> b) -> Bool
infoCheck a -> a -> b
property = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((a -> Bool) -> [a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Bool
forall b a. (Checkable b, Info a) => (a -> b) -> Bool
forall a. Info a => (a -> b) -> Bool
infoCheck((a -> b) -> Bool) -> (a -> a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a -> b
property) [a]
forall a. Info a => [a]
examples) 

test0 :: Bool
test0 = (Int -> Bool) -> Bool
forall b a. (Checkable b, Info a) => (a -> b) -> Bool
forall a. Info a => (a -> Bool) -> Bool
infoCheck (\Int
x -> (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=(Int
0::Int) Bool -> Bool -> Bool
|| Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0))
test1 :: Bool
test1 = (Int -> Int -> Bool) -> Bool
forall b a. (Checkable b, Info a) => (a -> b) -> Bool
forall a. Info a => (a -> Int -> Bool) -> Bool
infoCheck (\Int
x Int
y -> (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=(Int
0::Int) Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x))
test2 :: Bool
test2 = (Int -> Int -> Bool) -> Bool
forall b a. (Checkable b, Info a) => (a -> b) -> Bool
forall a. Info a => (a -> Int -> Bool) -> Bool
infoCheck (\Int
x Int
y -> (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=(Int
0::Int) Bool -> Bool -> Bool
|| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x))




-- A tour of the built-in Haskell classes
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

-- For details of the code here, please see the standard Prelude and Libraries.


-- Types and Classes
-- ^^^^^^^^^^^^^^^^^

-- The code in this section is not legal Haskell.

-- To evaluate the type of concat . map show, type

--  :type concat . map show

-- to the Hugs prompt.

-- Type checking and type inference
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

prodFun :: (t -> t1) -> (t -> t2) -> t -> (t1,t2)

prodFun :: forall t t1 t2. (t -> t1) -> (t -> t2) -> t -> (t1, t2)
prodFun t -> t1
f t -> t2
g = \t
x -> (t -> t1
f t
x, t -> t2
g t
x)



-- Checking types
-- ^^^^^^^^^^^^^^

-- Non-type-correct definitions are included as comments.

example1 :: Int
example1 = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3

--  example2 = fromEnum 'c' + False

--  f n     = 37+n
--  f True  = 34

--  g 0 = 37
--  g n = True

--  h x 
--    | x>0         = True
--    | otherwise   = 37

--  k x = 34
--  k 0 = 35


-- Polymorphic type checking
-- ^^^^^^^^^^^^^^^^^^^^^^^^^

-- Examples without their types; use Hugs to find them out.

f :: (a, Char) -> (a, [Char])
f (a
x,Char
y) = (a
x , [Char
'a' .. Char
y])

g :: (Int, t a) -> Int
g (Int
m,t a
zs) = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
zs

h :: (Int, Char) -> Int
h = (Int, [Char]) -> Int
forall {t :: * -> *} {a}. Foldable t => (Int, t a) -> Int
g ((Int, [Char]) -> Int)
-> ((Int, Char) -> (Int, [Char])) -> (Int, Char) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> (Int, [Char])
forall {a}. (a, Char) -> (a, [Char])
f

expr :: Int
expr :: Int
expr = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([][Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++[Bool
True]) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([][Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++[Integer
2,Integer
3,Integer
4]) 

-- The funny function does not type check.

--  funny xs = length (xs++[True]) + length (xs++[2,3,4])


-- Type checking and classes
-- ^^^^^^^^^^^^^^^^^^^^^^^^^

-- Membership on lists

member :: Eq a => [a] -> a -> Bool

member :: forall a. Eq a => [a] -> a -> Bool
member []     a
y = Bool
False
member (a
x:[a]
xs) a
y = (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y) Bool -> Bool -> Bool
|| [a] -> a -> Bool
forall a. Eq a => [a] -> a -> Bool
member [a]
xs a
y

-- Merging ordered lists.

merge :: [a] -> [a] -> [a]
merge (a
x:[a]
xs) (a
y:[a]
ys) 
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y         = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y        = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
xs [a]
ys
  | Bool
otherwise   = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
merge (a
x:[a]
xs) []    = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
merge []    (a
y:[a]
ys) = (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
merge []    []     = []