Haskell Programming Chapter 11 Part 2

ch11.hs

module Ch11 where

import Data.Char

data GuessWhat =
  Chickenbutt deriving (Eq, Show)

data Id a =
  MkId a deriving (Eq, Show)

data Product a b =
  Product a b deriving (Eq, Show)

data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

data RecordProduct a b =
  RecordProduct { pfirst :: a
                , psecond :: b }
                deriving (Eq, Show)

--- Sum and Product

newtype NumCow =
  NumCow Int
  deriving (Eq, Show)

newtype NumPig =
  NumPig Int
  deriving (Eq, Show)

data Farmhouse =
  Farmhouse NumCow NumPig
  deriving (Eq, Show)

type Farmhouse' = Product NumCow NumPig

---

newtype NumSheep =
  NumSheep Int
  deriving (Eq, Show)

data BigFarmhouse =
  BigFarmhouse NumCow NumPig NumSheep
  deriving (Eq, Show)

type BigFarmhouse' =
  Product NumCow (Product NumPig NumSheep)

---

type AnimalName = String
type Age = Int
type LovesMud = Bool
type PoundsOfWool = Int

data CowInfo =
  CowInfo AnimalName Age
  deriving (Eq, Show)

data PigInfo =
  PigInfo AnimalName Age LovesMud
  deriving (Eq, Show)

data SheepInfo =
  SheepInfo AnimalName Age PoundsOfWool
  deriving (Eq, Show)

data Animal =
     Cow CowInfo
   | Pig PigInfo
   | Sheep SheepInfo
   deriving (Eq, Show)

type Animal' =
  Sum CowInfo (Sum PigInfo SheepInfo)

--- Constructing values

-- Nullary constructor
trivialValue :: GuessWhat
trivialValue = Chickenbutt

---- Defined above
-- data Id a =
--   MkId a deriving (Eq, Show)

-- Unary constructor
idInt :: Id Integer
idInt = MkId 10

-- functions themselves are merely values. So we can also do this

idIdentity :: Id (a -> a)
idIdentity = MkId $ \x -> x

-- Sum

data Twitter =
  Twitter deriving (Eq, Show)

data AskFm =
  AskFm deriving (Eq, Show)

socialNetwork :: Sum Twitter AskFm
socialNetwork = First Twitter

-- Product

myRecord :: RecordProduct Integer Float
myRecord = RecordProduct 42 0.00001

myRecord' = RecordProduct { pfirst = 42
                          , psecond = 0.00001 }


data OperatingSystem =
       GnuPlusLinux
     | OpenBSDPlusNevermindJustBSDStill
     | Mac
     | Windows
     deriving (Eq, Show)

data ProgrammingLanguage =
     Haskell
   | Agda
   | Idris
   | PureScript
   deriving (Eq, Show)

data Programmer =
  Programmer { os :: OperatingSystem
             , lang :: ProgrammingLanguage }
  deriving (Eq, Show)

nineToFive :: Programmer
nineToFive = Programmer { os = Mac
                        , lang = Haskell }

-- We can reorder stuff when we use record syntax
feelingWizardly :: Programmer
feelingWizardly = Programmer { lang = Agda
                             , os = GnuPlusLinux }


-- Exercise: Programmers

allOperatingSystems :: [OperatingSystem]
allOperatingSystems =
  [ GnuPlusLinux
  , OpenBSDPlusNevermindJustBSDStill
  , Mac
  , Windows
  ]

allLanguages :: [ProgrammingLanguage]
allLanguages = [Haskell, Agda, Idris, PureScript]

allProgrammers :: [Programmer]
allProgrammers = [Programmer o l | o <- allOperatingSystems, l <- allLanguages]

-- Accidental bottoms from records

data ThereYet =
  There Integer Float String Bool
  deriving (Eq, Show)

nope :: Float -> String -> Bool -> ThereYet
nope = There 10

notYet :: String -> Bool -> ThereYet
notYet = nope 25.5

notQuite :: Bool -> ThereYet
notQuite = notYet "woohoo"

yusssss :: ThereYet
yusssss = notQuite False

-- Deconstructing values

newtype Name    = Name String deriving Show
newtype Acres   = Acres Int deriving Show

data FarmerType = DairyFarmer
                | WheatFarmer
                | SoybeanFarmer deriving Show

data Farmer =
  Farmer Name Acres FarmerType deriving Show

isDairyFarmer :: Farmer -> Bool
isDairyFarmer (Farmer _ _ DairyFarmer) = True
isDairyFarmer _ = False

data FarmerRec =
  FarmerRec { name :: Name
            , acres :: Acres
            , farmerType :: FarmerType } deriving Show

isDairyFarmerRec :: FarmerRec -> Bool
isDairyFarmerRec farmer = case farmerType farmer of
  DairyFarmer -> True
  _           -> False

-- Accidental bottoms from records

-- Bad
data Automobile' = Null'
                 | Car' { make' :: String
                        , model' :: String
                        , year' :: Integer }
                 deriving (Eq, Show)

-- Better
data Car = Car { make :: String
               , model :: String
               , year :: Integer }
               deriving (Eq, Show)

data Automobile = Null
                | Automobile Car deriving (Eq, Show)

-- Function type is exponential

-- Sum type

data Quantum =
    Yes
  | No
  | Both
  deriving (Eq, Show)

-- 3+3

quantSum1 :: Either Quantum Quantum
quantSum1 = Right Yes

quantSum2 :: Either Quantum Quantum
quantSum2 = Right No

quantSum3 :: Either Quantum Quantum
quantSum3 = Right Both

quantSum4 :: Either Quantum Quantum
quantSum4 = Left Yes

quantSum5 :: Either Quantum Quantum
quantSum5 = Left No

quantSum6 :: Either Quantum Quantum
quantSum6 = Left Both

-- Product type
-- 3*3
quantProd1 :: (Quantum, Quantum)
quantProd1 = (Yes, Yes)
quantProd2 :: (Quantum, Quantum)
quantProd2 = (Yes, No)
quantProd3 :: (Quantum, Quantum)
quantProd3 = (Yes, Both)
quantProd4 :: (Quantum, Quantum)
quantProd4 = (No, Yes)
quantProd5 :: (Quantum, Quantum)
quantProd5 = (No, No)
quantProd6 :: (Quantum, Quantum)
quantProd6 = (No, Both)
quantProd7 :: (Quantum, Quantum)
quantProd7 = (Both, Yes)
quantProd8 :: (Quantum, Quantum)
quantProd8 = (Both, No)
quantProd9 :: (Quantum, Quantum)
quantProd9 = (Both, Both)

-- Function type
-- 3^3
quantFlip1 :: Quantum -> Quantum
quantFlip1 Yes  = Yes
quantFlip1 No   = Yes
quantFlip1 Both = Yes

quantFlip2 :: Quantum -> Quantum
quantFlip2 Yes  = Yes
quantFlip2 No   = Yes
quantFlip2 Both = No

-- ...lots more

-- 11.15 Higher-kinded datatypes

data Silly a b c d = MkSilly a b c d deriving Show

-- 11.16 Lists are polymorphic

data Product' a b =
  a :&: b
  deriving (Eq, Show)

data List a = Nil | Cons a (List a)

-- 11.17 Binary Tree

data BinaryTree a =
    Leaf
  | Node (BinaryTree a) a (BinaryTree a)
  deriving (Eq, Ord, Show)

insert' :: Ord a => a -> BinaryTree a -> BinaryTree a
insert' b Leaf = Node Leaf b Leaf
insert' b (Node left a right)
  | b == a = Node left a right
  | b < a  = Node (insert' b left) a right
  | b > a  = Node left a (insert' b right)

-- Write map for BinaryTree

mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left a right) =
  Node (mapTree f left) (f a) (mapTree f right)

testTree' :: BinaryTree Integer
testTree' =
  Node (Node Leaf 3 Leaf) 1 (Node Leaf 4 Leaf)

mapExpected =
  Node (Node Leaf 4 Leaf) 2 (Node Leaf 5 Leaf)

-- acceptance test for mapTree
mapOkay =
  if mapTree (+1) testTree' == mapExpected
  then print "yup okay!"
  else error "test failed!"

-- Convert binary trees to lists

preorder :: BinaryTree a -> [a]
preorder Leaf = []
preorder (Node left a right) =
  [a] ++ preorder left ++ preorder right

inorder :: BinaryTree a -> [a]
inorder Leaf = []
inorder (Node left a right) =
  preorder left ++ [a] ++ preorder right

postorder :: BinaryTree a -> [a]
postorder Leaf = []
postorder (Node left a right) =
  preorder left ++ preorder right ++ [a]

testTree :: BinaryTree Integer
testTree = Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf)

testPreorder :: IO ()
testPreorder =
  if preorder testTree == [2, 1, 3]
  then putStrLn "Preorder fine!"
  else putStrLn "Bad news bears."

testInorder :: IO ()
testInorder =
  if inorder testTree == [1, 2, 3]
  then putStrLn "Inorder fine!"
  else putStrLn "Bad news bears."

testPostorder :: IO ()
testPostorder =
  if postorder testTree == [1, 3, 2]
  then putStrLn "Postorder fine!"
  else putStrLn "postorder failed check"

-- Write foldr for BinaryTree

foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b
foldTree _ b Leaf = b
foldTree f b t = foldList f b (preorder t) where
  foldList _ b [] = b
  foldList f b (a:as) = (f a (foldList f b as))

-- language exercises

-- capitalize a word
capitalizeWord :: String -> String
capitalizeWord "" = ""
capitalizeWord (c:cs)
  | c == ' ' = c : capitalizeWord cs
  | otherwise = toUpper c : cs

-- capitalize sentences

capitalizeParagraph :: String -> String

capitalizeParagraph s = run "" s where
  run acc "" = acc
  run acc (c:cs)
    | c == '.' = capitalizeWord acc ++ "." ++ run "" cs
    | otherwise = run (acc ++ [c]) cs

-- Phone exercise

data DaPhone = DaPhone

type Digit = Char
type Presses = Int

-- http://www.asciitable.com/
keyMap :: [[(Digit, Presses)]]
keyMap = replicate 32 []
  ++ [[('0', 2)]]
  ++ replicate 2 []
  ++ [[('#', 1)]]
  ++ replicate 6 []
  ++ [[('*', 1)]
     ,[('0', 1)]
     ,[('#', 3)]
     ,[]
     ,[('#', 2)]
     ,[]
     ,[('0', 3)]
     ,[('1', 1)]
     ,[('2', 4)]
     ,[('3', 4)]
     ,[('4', 4)]
     ,[('5', 4)]
     ,[('6', 4)]
     ,[('7', 5)]
     ,[('8', 4)]
     ,[('9', 5)]]
  ++ replicate 7 []
  ++ [[('*', 1), ('2', 1)]
     ,[('*', 1), ('2', 2)]
     ,[('*', 1), ('2', 3)]
     ,[('*', 1), ('3', 1)]
     ,[('*', 1), ('3', 2)]
     ,[('*', 1), ('3', 3)]
     ,[('*', 1), ('4', 1)]
     ,[('*', 1), ('4', 2)]
     ,[('*', 1), ('4', 3)]
     ,[('*', 1), ('5', 1)]
     ,[('*', 1), ('5', 2)]
     ,[('*', 1), ('5', 3)]
     ,[('*', 1), ('6', 1)]
     ,[('*', 1), ('6', 2)]
     ,[('*', 1), ('6', 3)]
     ,[('*', 1), ('7', 1)]
     ,[('*', 1), ('7', 2)]
     ,[('*', 1), ('7', 3)]
     ,[('*', 1), ('7', 4)]
     ,[('*', 1), ('8', 1)]
     ,[('*', 1), ('8', 2)]
     ,[('*', 1), ('8', 3)]
     ,[('*', 1), ('9', 1)]
     ,[('*', 1), ('9', 2)]
     ,[('*', 1), ('9', 3)]
     ,[('*', 1), ('9', 4)]]
  ++ replicate 3 []
  ++ [[('*', 2)]]
  ++ replicate 2 []
  ++ [[('2', 1)]
     ,[('2', 2)]
     ,[('2', 3)]
     ,[('3', 1)]
     ,[('3', 2)]
     ,[('3', 3)]
     ,[('4', 1)]
     ,[('4', 2)]
     ,[('4', 3)]
     ,[('5', 1)]
     ,[('5', 2)]
     ,[('5', 3)]
     ,[('6', 1)]
     ,[('6', 2)]
     ,[('6', 3)]
     ,[('7', 1)]
     ,[('7', 2)]
     ,[('7', 3)]
     ,[('7', 4)]
     ,[('8', 1)]
     ,[('8', 2)]
     ,[('8', 3)]
     ,[('9', 1)]
     ,[('9', 2)]
     ,[('9', 3)]
     ,[('9', 4)]]

reverseTaps' :: Char -> [(Digit, Presses)]
reverseTaps' c = keyMap !! ord c

cellPhonesDead' :: String -> [(Digit, Presses)]
cellPhonesDead' s = concat $ map reverseTaps' s

convo :: [String]
convo =
  ["Wanna play 20 questions",
   "Ya",
   "U 1st haha",
   "Lol ok. Have u ever tasted alcohol lol",
   "Lol ya",
   "Wow ur cool haha. Ur turn",
   "Ok. Do u think I am pretty Lol",
   "Lol ya",
   "Haha thanks just making sure rofl ur turn"]

convoTaps = concat $ map cellPhonesDead' convo


fingerTaps :: [(Digit, Presses)] -> Presses
fingerTaps = foldr (\(d, p) s -> s + p) 0

convoFingerTaps = fingerTaps $ convoTaps

haskell-programming-ch11-part2.md

11.13 Constructing and deconstructing values

2 things we can do with a value:

• generate/construct
• match/consume

Data is immutable in Haskell, so values carry with them the information about how they were created. We can use that information when we consume or deconstruct the value.

Some example data types

Nullary constructor

data GuessWhat =
  Chickenbutt deriving (Eq, Show)

Unary constructor

data Id a =
  MkId a deriving (Eq, Show)

Product constructor

data Product a b =
  Product a b deriving (Eq, Show)

Product constructor with record syntax

data RecordProduct a b =
  RecordProduct { pfirst :: a
                , psecond :: b }
                deriving (Eq, Show)

Sum constructor

data Sum a b =
    First a
  | Second b
  deriving (Eq, Show)

Sum and Product

In ordinary Haskell code, it’s unlikely you’d need or want nestable sums and products unless you were doing something fairly advanced,

The actual types Sum and Product themselves aren’t used very often in standard Haskell code, but it can be useful to develop an intuition about this structure to sum and product types.

Constructing values

Nullary

trivialValue :: GuessWhat
trivialValue = Chickenbutt

Unary

idInt :: Id Integer
idInt = MkId 10

I don't understand this example and the following passage.

idIdentity :: Id (a -> a)
idIdentity = MkId $ \x -> x

This is a little odd. The type Id takes an argument and the data constructor MkId takes an argument of the corresponding polymor- phic type. So, in order to have a value of type Id Integer, we need to apply a -> Id a to an Integer value. This binds the 𝑎 type variable to Integer and applies away the (->) in the type constructor, giving us Id Integer. We can also construct a MkId value that is an identity function by binding the 𝑎 to a polymorphic function in both the type and the term level.

Sum

data Twitter =
  Twitter deriving (Eq, Show)

data AskFm =
  AskFm deriving (Eq, Show)

socialNetwork :: Sum Twitter AskFm
socialNetwork = First Twitter

Order is important. We must pair First and Second with the appropriate data type

Prelude> Second Twitter :: Sum Twitter AskFm
-- ERROR

Using type synonyms instead of data types is dangerous. In this example we prevent the type checker from being able to help us catch errors. Don't do this.

type Twitter = String
type AskFm = String

twitter :: Sum Twitter AskFm 
twitter = First "Twitter"

-- It has no way of knowing
-- we made a mistake because
-- both values are just Strings 
askfm :: Sum Twitter AskFm 
askfm = First "AskFm"

Product

you can construct values of products that use record syntax in a manner identical to that of non-record products

myRecord :: RecordProduct Integer Float
myRecord = RecordProduct 42 0.00001

myRecord' = RecordProduct { pfirst = 42
                          , psecond = 0.00001 }

You can reorder the constructor fields when using record syntax

nineToFive :: Programmer
nineToFive = Programmer { os = Mac
                        , lang = Haskell }

feelingWizardly :: Programmer
feelingWizardly = Programmer { lang = Agda
                             , os = GnuPlusLinux }

A reminder that the field names act as functions

Prelude> os feelingWizardly
GnuPlusLinux

Exercise: Programmers

Write a function that generates all possible values of Programmer.

allOperatingSystems :: [OperatingSystem]
allOperatingSystems =
  [ GnuPlusLinux
  , OpenBSDPlusNevermindJustBSDStill
  , Mac
  , Windows
  ]

allLanguages :: [ProgrammingLanguage]
allLanguages = [Haskell, Agda, Idris, PureScript]

allProgrammers :: [Programmer]
allProgrammers = [Programmer o l | o <- allOperatingSystems, l <- allLanguages]

Accidental bottoms from records

It is only a warning to construct a value using record syntax but not specify all the fields. Don't do this.

Prelude> let partialAf = Programmer {os = GnuPlusLinux}
Prelude> partialAf
--ERROR

If you need to specify some of field values use a normal, ordered data constructor.

Some shade is thrown at the Builder Pattern https://en.wikipedia.org/wiki/Builder_pattern

Percolate values through your programs, not bottoms.

Deconstructing values

We explained that catamorphism was about deconstructing lists. This idea is generally applicable to any datatype that has values.

newtype Name    = Name String deriving Show
newtype Acres   = Acres Int deriving Show

data FarmerType = DairyFarmer
                | WheatFarmer
                | SoybeanFarmer deriving Show

data Farmer =
  Farmer Name Acres FarmerType deriving Show

isDairyFarmer :: Farmer -> Bool
isDairyFarmer (Farmer _ _ DairyFarmer) = True 
isDairyFarmer _ = False

Record version

data FarmerRec =
  FarmerRec { name :: Name
            , acres :: Acres
            , farmerType :: FarmerType } deriving Show

isDairyFarmerRec :: FarmerRec -> Bool
isDairyFarmerRec farmer = case farmerType farmer of
  DairyFarmer -> True
  _           -> False

Accidental bottoms from records

More warnings to avoid introducing bottoms. Don't do this

data Automobile' = Null'
                 | Car' { make' :: String
                        , model' :: String
                        , year' :: Integer }
                 deriving (Eq, Show)

Instead, define record-style product types separate from the sum types that incorporate them.

data Car = Car { make :: String
               , model :: String
               , year :: Integer }
               deriving (Eq, Show)

data Automobile = Null
                | Automobile Car deriving (Eq, Show)

11.14 Function type is exponential

When calculating the number of inhabitants of a function, exponentiate the number of inhabitants of the types.

a -> b = b^a

a -> b -> c = (c^b)^a = c^(b*a)

data Quantum =
    Yes
| No
| Both
deriving (Eq, Show)

quantSum :: Either Quantum Quantum
quantProd :: (Quantum, Quantum)
quantFunc :: Quantum -> Quantum

Exponentiation in what order?

There should be 2^3 = 8.

convert :: Quantum -> Bool 
convert = undefined

convert1 :: Quantum -> Bool
convert1 Yes = True
convert1 No = True
convert1 Both = True

convert2 :: Quantum -> Bool
convert2 Yes = False
convert2 No = False
convert2 Both = False

convert3 :: Quantum -> Bool
convert3 Yes = True
convert3 No = False
convert3 Both = False

convert4 :: Quantum -> Bool
convert4 Yes = False
convert4 No = True
convert4 Both = False

convert5 :: Quantum -> Bool
convert5 Yes = False
convert5 No = False
convert5 Both = True

convert6 :: Quantum -> Bool
convert6 Yes = True
convert6 No = True
convert6 Both = False

convert7 :: Quantum -> Bool
convert7 Yes = False
convert7 No = True
convert7 Both = True

convert8 :: Quantum -> Bool
convert8 Yes = True
convert8 No = False
convert8 Both = True

Exercises: The Quad

Determine how many unique inhabitants each type has.

1. data Quad = One | Two | Three | Four deriving (Eq, Show)

   -- how many different forms can this take? eQuad :: Either Quad Quad eQuad = ???

2. prodQuad :: (Quad, Quad) 4*4 = 16

3. funcQuad :: Quad -> Quad 4^4 = 256

4. prodTBool :: (Bool, Bool, Bool) (2*2)*2 = 8

5. gTwo :: Bool -> Bool -> Bool (2^2)^2 = 2^(2*2) = 2^4 = 16

6. Hint: 5 digit number fTwo :: Bool -> Quad -> Quad (4^4)^2 = 4^(4*2) = 4^8 = 65536

11.15 Higher-kinded datatypes

Higher-kind means that not all the types have been applied.

The kind of a product type has a * -> for each component type and a * for the final value.

data Silly a b c d = MkSilly a b c d deriving Show

Prelude> :kind Silly
Silly :: * -> * -> * -> * -> *

Prelude> :kind Silly Int String 
Silly Int String :: * -> * -> *


Prelude> :kind Silly Int String Bool String 
Silly Int String Bool String :: *

Fully applied types have a kind of *

Prelude> :kind (Int, String, Bool, String)
(Int, String, Bool, String) :: *

Real-world example of a higher kinded function.

I don't understand what is going on here.

data EsResultFound a =
  EsResultFound { _version :: DocVersion
                , _source :: a 
  } deriving (Eq, Show)


instance (FromJSON a) => FromJSON (EsResultFound a) where
  parseJSON (Object v) = EsResultFound <$>
                         v .: "_version" <*>
                         v .: "_source"
  parseJSON _ = empty

As you can hopefully see from this, by not fully applying the type — by leaving it higher-kinded — space is le for the type of the response to vary, for the “hole” to be filled in by the end user.

11.16 Lists are polymorphic

Lists are polymorphic because they can contain values of any type.

Infix type and data constructors

When we give an operator a non-alphanumeric name, it is infix by default. Any operator that starts with a colon (:) must be an infix type or data constructor.

data Product' a b =
  a :&: b
  deriving (Eq, Show) 

Prelude> 1 :&: 2
1 :&: 2
Prelude> :t 1 :&: 2
1 :&: 2 :: (Num a, Num b) => Product' a b

Whether or not you choose to use infix data constructors, type constructors, or typeclass names is down to aesthetic preference.

List without infix operator :

data List a = Nil | Cons a (List a)

Has the same kinds as the native list

Prelude> :kind List
List :: * -> *
Prelude> :kind []
[] :: * -> *
Prelude> :kind List Int
List Int :: *
Prelude> :kind [Int]
[Int] :: *

11.17 Binary Tree

Similar to a List. If only the right sides of all nodes are filled it is essentially the same as a list.

data BinaryTree a =
    Leaf
  | Node (BinaryTree a) a (BinaryTree a)
  deriving (Eq, Ord, Show)

Inserting into trees

The first thing to be aware of is that we need Ord in order to have enough information about our values to know how to arrange them in our tree.

insert' :: Ord a => a -> BinaryTree a -> BinaryTree a
insert' b Leaf = Node Leaf b Leaf
insert' b (Node left a right)
  | b == a = Node left a right
  | b < a  = Node (insert' b left) a right
  | b > a  = Node left a (insert' b right)

By convention we put lesser values in left-hand trees and greater values in right hand trees.

Data is immutable so we are always creating new trees when we add nodes.

Write map for BinaryTree

The structure inherent in the def- inition of the type is all you need. Just write the recursive functions and get it done.

There was a lot of help text explaining how to solve this which makes me suspicious of 2-minute solution, even though is passes the simple test.

mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left a right) =
  Node (mapTree f left) (f a) (mapTree f right)

Convert binary trees to lists

preorder :: BinaryTree a -> [a]
preorder Leaf = []
preorder (Node left a right) =
  [a] ++ preorder left ++ preorder right

inorder :: BinaryTree a -> [a]
inorder Leaf = []
inorder (Node left a right) =
  preorder left ++ [a] ++ preorder right

postorder :: BinaryTree a -> [a]
postorder Leaf = []
postorder (Node left a right) =
  preorder left ++ preorder right ++ [a]

Write foldr for BinaryTree

I started sketching a direct fold of the tree, stared at it in confusion for a few minutes, then realized it would be simple to just convert the tree to a list and then fold the list.

foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b
foldTree _ b Leaf = b
foldTree f b t = foldList f b (preorder t) where
  foldList _ b [] = b
  foldList f b (a:as) = (f a (foldList f b as))

11.18 Chapter Exercises

Language exercises

1. Write a function that capitalizes a word.

capitalizeWord :: String -> String
capitalizeWord "" = ""
capitalizeWord (c:cs) = toUpper c : cs

Example output. Prelude> capitalizeWord "Titter" "Titter" Prelude> capitalizeWord "titter" "Titter"

2. Write a function that capitalizes sentences in a paragraph. Recognize when a new sentence has begun by checking for periods. Reuse the capitalizeWord function.

My solution depends on capitalizeWord working with leading whitespace (i.e. capitalizeWord " foo" = " Foo")

capitalizeParagraph :: String -> String
capitalizeParagraph s = run "" s where
  run acc "" = acc
  run acc (c:cs)
    | c == '.' = capitalizeWord acc ++ "." ++ run "" cs
    | otherwise = run (acc ++ [c]) cs

Phone exercise

I have a partial solution but I don't think it is what they are looking for since I did not define a DaPhone data type.

http://www.asciitable.com/

keyMap :: [[(Digit, Presses)]]
keyMap = replicate 32 []
  ++ [[('0', 2)]]
  ++ replicate 2 []
  ++ [[('#', 1)]]
  ++ replicate 6 []
  ++ [[('*', 1)]
     ,[('0', 1)]
     ,[('#', 3)]
     ,[]
     ,[('#', 2)]
     ,[]
     ,[('0', 3)]
     ,[('1', 1)]
     ,[('2', 4)]
     ,[('3', 4)]
     ,[('4', 4)]
     ,[('5', 4)]
     ,[('6', 4)]
     ,[('7', 5)]
     ,[('8', 4)]
     ,[('9', 5)]]
  ++ replicate 7 []
  ++ [[('*', 1), ('2', 1)]
     ,[('*', 1), ('2', 2)]
     ,[('*', 1), ('2', 3)]
     ,[('*', 1), ('3', 1)]
     ,[('*', 1), ('3', 2)]
     ,[('*', 1), ('3', 3)]
     ,[('*', 1), ('4', 1)]
     ,[('*', 1), ('4', 2)]
     ,[('*', 1), ('4', 3)]
     ,[('*', 1), ('5', 1)]
     ,[('*', 1), ('5', 2)]
     ,[('*', 1), ('5', 3)]
     ,[('*', 1), ('6', 1)]
     ,[('*', 1), ('6', 2)]
     ,[('*', 1), ('6', 3)]
     ,[('*', 1), ('7', 1)]
     ,[('*', 1), ('7', 2)]
     ,[('*', 1), ('7', 3)]
     ,[('*', 1), ('7', 4)]
     ,[('*', 1), ('8', 1)]
     ,[('*', 1), ('8', 2)]
     ,[('*', 1), ('8', 3)]
     ,[('*', 1), ('9', 1)]
     ,[('*', 1), ('9', 2)]
     ,[('*', 1), ('9', 3)]
     ,[('*', 1), ('9', 4)]]
  ++ replicate 3 []
  ++ [[('*', 2)]]
  ++ replicate 2 []
  ++ [[('2', 1)]
     ,[('2', 2)]
     ,[('2', 3)]
     ,[('3', 1)]
     ,[('3', 2)]
     ,[('3', 3)]
     ,[('4', 1)]
     ,[('4', 2)]
     ,[('4', 3)]
     ,[('5', 1)]
     ,[('5', 2)]
     ,[('5', 3)]
     ,[('6', 1)]
     ,[('6', 2)]
     ,[('6', 3)]
     ,[('7', 1)]
     ,[('7', 2)]
     ,[('7', 3)]
     ,[('7', 4)]
     ,[('8', 1)]
     ,[('8', 2)]
     ,[('8', 3)]
     ,[('9', 1)]
     ,[('9', 2)]
     ,[('9', 3)]
     ,[('9', 4)]]

reverseTaps' :: Char -> [(Digit, Presses)]
reverseTaps' c = keyMap !! ord c

cellPhonesDead' :: String -> [(Digit, Presses)]
cellPhonesDead' s = concat $ map reverseTaps' s

convo :: [String]
convo =
  ["Wanna play 20 questions",
   "Ya",
   "U 1st haha",
   "Lol ok. Have u ever tasted alcohol lol",
   "Lol ya",
   "Wow ur cool haha. Ur turn",
   "Ok. Do u think I am pretty Lol",
   "Lol ya",
   "Haha thanks just making sure rofl ur turn"]

convoTaps = concat $ map cellPhonesDead' convo


fingerTaps :: [(Digit, Presses)] -> Presses
fingerTaps = foldr (\(d, p) s -> s + p) 0

convoFingerTaps = fingerTaps $ convoTaps

This is the beginning of my overengineered and likely to end up very stupid implementation of the phone:

module PhoneExercise where

import Data.Maybe

data PhoneKey = PhoneKey { key :: Char,
                           symbols :: [Char] }
  deriving (Eq, Show)

data PhoneLayout = PhoneLayout [PhoneKey]
  deriving (Eq, Show)

layout :: PhoneLayout
layout = PhoneLayout [
  PhoneKey '1' "",
  PhoneKey '2' "abc",
  PhoneKey '3' "def",
  PhoneKey '4' "ghi",
  PhoneKey '5' "jkl",
  PhoneKey '6' "mno",
  PhoneKey '7' "pqrs",
  PhoneKey '8' "tuv",
  PhoneKey '9' "wxyz",
  PhoneKey '*' "^",
  PhoneKey '0' "+_",
  PhoneKey '#' ".,"
  ]

getChars :: Char -> PhoneLayout -> Maybe String
getChars _ (PhoneLayout []) = Nothing
getChars ch (PhoneLayout keys) = Just $
  symbols $ head $ filter (\phKey -> key phKey == ch) keys

getKey :: Char -> PhoneLayout -> Maybe PhoneKey
getKey _ (PhoneLayout []) = Nothing
getKey c (PhoneLayout keys) = listToMaybe $
  filter (\phKey -> (elem c (symbols phKey))) keys

rotateKeys :: Int -> String -> String
rotateKeys _ "" = ""
rotateKeys i s
  | (mod i $ length s) == 0 = s
  | otherwise = go 0 (mod i $ length s) s where
      go z t st
        | z == t = st
        | z < t = go (z + 1) t (tail st ++ [head st])