Solutions to Phone exercise from Chapter 11 of Haskellbook

Chapter11Phone.hs

module Chapter11Phone where

import Data.Char (isLetter, isNumber, isUpper, toLower)
import Data.List (group, sort)

data CharType = Letter Char
              | Number Char
              | Punctuation Char
              deriving (Eq, Show)

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"
  ]

-- validButtons = "123456789*#"
type Digit = Char

-- valid presses: 1 and up
type Presses = Int

reverseTaps :: Char -> [(Digit, Presses)]
reverseTaps ch = case categorizeChar ch of
  Just c  -> encodeChar c
  Nothing -> []

categorizeChar :: Char -> Maybe CharType
categorizeChar ch
  | isLetter ch     = Just $ Letter ch
  | isNumber ch     = Just $ Number ch
  | elem ch "* #.," = Just $ Punctuation ch
  | otherwise       = Nothing

encodeChar :: CharType -> [(Digit, Presses)]
encodeChar (Letter ch)      = encodeLetter ch
encodeChar (Number ch)      = encodeNumber ch
encodeChar (Punctuation ch) = encodePunctuation ch

encodePunctuation :: Char -> [(Digit, Presses)]
encodePunctuation ' ' = [('0',1)]
encodePunctuation '.' = [('#',1)]
encodePunctuation ',' = [('#',2)]
encodePunctuation '#' = [('#',3)]

encodeLetter :: Char -> [(Digit, Presses)]
encodeLetter ch = case isUpper ch of
  True  -> [('*', 1)] ++ (encodeLetter $ toLower ch)
  False -> go ch
    where go 'a' = [('2', 1)]
          go 'b' = [('2', 2)]
          go 'c' = [('2', 3)]
          go 'd' = [('3', 1)]
          go 'e' = [('3', 2)]
          go 'f' = [('3', 3)]
          go 'g' = [('4', 1)]
          go 'h' = [('4', 2)]
          go 'i' = [('4', 3)]
          go 'j' = [('5', 1)]
          go 'k' = [('5', 2)]
          go 'l' = [('5', 3)]
          go 'm' = [('6', 1)]
          go 'n' = [('6', 2)]
          go 'o' = [('6', 3)]
          go 'p' = [('7', 1)]
          go 'q' = [('7', 2)]
          go 'r' = [('7', 3)]
          go 's' = [('7', 4)]
          go 't' = [('8', 1)]
          go 'u' = [('8', 2)]
          go 'v' = [('8', 3)]
          go 'w' = [('9', 1)]
          go 'x' = [('9', 2)]
          go 'y' = [('9', 3)]
          go 'z' = [('9', 4)]

-- encode 0-9
encodeNumber :: Char -> [(Digit, Presses)]
encodeNumber '1' = [('1', 1)]
encodeNumber '0' = [('0', 2)]
encodeNumber d = [(d, 4)]

-- originally cellPhonesDead; renamed for clarity
encodeString :: String -> [(Digit, Presses)]
encodeString = concat . fmap reverseTaps

-- how many times do digits need to be pressed for each message?
fingerTaps :: [(Digit, Presses)] -> Presses
fingerTaps = sum . map snd

-- most popular letter on the phone keyboard?
mostPopularLetter :: String -> Char
mostPopularLetter str = snd $ foldr maxBy (-1, ' ') counts
  where encodedString = encodeString str
        expandedString = concat $ fmap expandTuple encodedString
        digitRuns = group $ sort expandedString
        counts = fmap buildTuples digitRuns

expandTuple :: (a, Int) -> [a]
expandTuple (a, b) = take b $ repeat a

maxBy :: Ord a => (a, b) -> (a, b) -> (a, b)
maxBy x@(xCount, _) y@(yCount, _) = if xCount > yCount then x else y

buildTuples :: [a] -> (Int, a)
buildTuples list@(x:_) = (length list, x)

-- damn, you, partial functions!
coolestLtr :: [String] -> Char
coolestLtr strs = snd $ foldr maxBy (-1, ' ') $ fmap buildTuples $ group $ sort $ concat strs

coolestWord :: [String] -> String
coolestWord strs = snd $ foldr maxBy (-1, "") counts
  where groupedWords = group $ sort strs
        counts = fmap buildTuples groupedWords

--helper for testing
coolestWord' :: String -> String
coolestWord' str = coolestWord $ words str