Add the haskell book

Haskell-book/11/As.hs

@@ -0,0 +1,30 @@
+module As where
+
+import Data.Char
+
+isSubseqOf :: (Eq a) => [a] -> [a] -> Bool
+isSubseqOf [] _ = True
+isSubseqOf _ [] = False
+isSubseqOf a@(x:xs) (y:ys)
+  | x == y    = isSubseqOf xs ys
+  | otherwise = isSubseqOf a ys
+
+capitalize :: Char -> Char
+capitalize x
+  | (ord x) >= (ord 'a') = (chr ((ord x) - 32))
+  | otherwise            = x
+
+capitalizeWords :: String -> [(String, String)]
+capitalizeWords text = map f (words text)
+    where f w@(x:xs) = (w, (capitalize x) : xs)
+
+capitalizeWord :: String -> String
+capitalizeWord (x:xs) = (capitalize x) : xs
+
+capitalizeParagraph :: String -> String
+capitalizeParagraph = it True
+    where it _ [] = []
+          it _ ('.':xs) = '.' : (it True xs)
+          it y (x:xs)
+            | (ord x) >= (ord 'a') && (ord x) < (ord 'z') && y = (capitalize x) : (it False xs)
+            | otherwise                                        = x              : (it y xs)

Haskell-book/11/BinaryTree.hs

@@ -0,0 +1,87 @@
+module BinaryTree where
+
+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)
+
+mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
+mapTree _ Leaf = Leaf
+mapTree f (Node left v right) =
+    Node (mapTree f left) (f v) (mapTree f right)
+
+preorder :: BinaryTree a -> [a]
+preorder Leaf = []
+preorder (Node left v right) =
+    v : ((preorder left) ++ (preorder right))
+
+inorder :: BinaryTree a -> [a]
+inorder Leaf = []
+inorder (Node left v right) =
+    (inorder left) ++ [v] ++ (inorder right)
+
+postorder :: BinaryTree a -> [a]
+postorder Leaf = []
+postorder (Node left v right) =
+    ((postorder left) ++ (postorder right)) ++ [v]
+
+foldTree :: (a -> b -> b)
+         -> b
+         -> BinaryTree a
+         -> b
+foldTree _ acc Leaf = acc
+foldTree f acc (Node left v right) = foldTree f r left
+    where r = foldTree f (f v acc) right
+
+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"
+
+main :: IO ()
+main = do
+    testPreorder
+    testInorder
+    testPostorder
+
+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!"

Haskell-book/11/Cipher.hs

@@ -0,0 +1,24 @@
+module Cipher where
+
+import Data.Char
+import Data.List
+
+decode :: (Char, Int) -> Char
+decode (x, y) =  chr ((mod ((ord x) - 65 + y) 26) + 65)
+
+decodeWithKey :: [Int] -> String -> String
+decodeWithKey _      []       = []
+decodeWithKey ys     (' ':xs) = ' ' : (decodeWithKey ys xs)
+decodeWithKey (y:ys) (x:xs)   = (decode (x, y)) : (decodeWithKey ys xs)
+
+vigenere :: String -> String
+vigenere = decodeWithKey (cycle [0, 11, 11, 24])
+
+caeser :: String -> String
+caeser = decodeWithKey (cycle [11])
+
+main :: IO ()
+main = do
+    putStrLn (vigenere "MEET AT DAWN")
+    putStrLn (caeser "MEET AT DAWN")
+    return ()

Haskell-book/11/Garden.hs

@@ -0,0 +1,11 @@
+module Garden where
+
+data FlowerType = Gardenia
+                | Daisy
+                | Rose
+                | Lilac
+                deriving Show
+
+type Gardener = String
+
+data Garden = Garden Gardener FlowerType deriving Show

Haskell-book/11/Hutton.hs

@@ -0,0 +1,13 @@
+module Hutton where
+
+data Expr
+    = Lit Integer
+    | Add Expr Expr
+
+eval :: Expr -> Integer
+eval (Lit x)   = x
+eval (Add x y) = (eval x) + (eval y)
+
+printExpr :: Expr -> String
+printExpr (Lit x) = show x
+printExpr (Add x y) = (printExpr x) ++ " + " ++ (printExpr y)

Haskell-book/11/Phone.hs

@@ -0,0 +1,87 @@
+module Phone where
+
+import Data.Char (ord)
+import Data.List (sortBy)
+
+data DaPhone = DaPhone
+
+convo :: [String]
+convo =
+    [ "Wanna play 20 questions"
+    , "Ya"
+    , "U 1st haha"
+    , "Lol ok. Have u ever tasted alcohol"
+    , "Lol ya"
+    , "Wow ur cool haha. Ur turn"
+    , "Ok. Do u think I am pretty Lol"
+    , "Lol ya"
+    , "Just making sure rofl ur turn" ]
+
+-- validButtons = "1234567890*#"
+type Digit = Char
+
+-- Valid presses: 1 and up
+type Presses = Int
+
+data Button = Button Digit String
+
+-- assuming the default phone definition
+-- 'a' -> [('2', 1)]
+-- 'A' -> [('*', 1), ('2', 1)]
+reverseTaps :: DaPhone -> Char -> [(Digit, Presses)]
+reverseTaps _ c
+  | c == '.' = [('#', 1)]
+  | c == ',' = [('#', 2)]
+  | c == '#' = [('#', 3)]
+  | c == '+' = [('0', 1)]
+  | c == ' ' = [('0', 2)]
+  | c == '0' = [('0', 3)]
+  | (ord c) >= (ord 'w') = [('9', (ord c) - (ord 'w') + 1)]
+  | (ord c) >= (ord 't') = [('8', (ord c) - (ord 't') + 1)]
+  | (ord c) >= (ord 'p') = [('7', (ord c) - (ord 'p') + 1)]
+  | (ord c) >= (ord 'm') = [('6', (ord c) - (ord 'm') + 1)]
+  | (ord c) >= (ord 'j') = [('5', (ord c) - (ord 'j') + 1)]
+  | (ord c) >= (ord 'g') = [('4', (ord c) - (ord 'g') + 1)]
+  | (ord c) >= (ord 'd') = [('3', (ord c) - (ord 'd') + 1)]
+  | (ord c) >= (ord 'a') = [('2', (ord c) - (ord 'a') + 1)]
+  | (ord c) >= (ord 'W') = [('*', 1), ('9', (ord c) - (ord 'W') + 1)]
+  | (ord c) >= (ord 'T') = [('*', 1), ('8', (ord c) - (ord 'T') + 1)]
+  | (ord c) >= (ord 'P') = [('*', 1), ('7', (ord c) - (ord 'P') + 1)]
+  | (ord c) >= (ord 'M') = [('*', 1), ('6', (ord c) - (ord 'M') + 1)]
+  | (ord c) >= (ord 'J') = [('*', 1), ('5', (ord c) - (ord 'J') + 1)]
+  | (ord c) >= (ord 'G') = [('*', 1), ('4', (ord c) - (ord 'G') + 1)]
+  | (ord c) >= (ord 'D') = [('*', 1), ('3', (ord c) - (ord 'D') + 1)]
+  | (ord c) >= (ord 'A') = [('*', 1), ('2', (ord c) - (ord 'A') + 1)]
+  | c == '9' = [('9', 5)]
+  | c == '8' = [('8', 4)]
+  | c == '7' = [('7', 5)]
+  | c == '6' = [('6', 4)]
+  | c == '5' = [('5', 4)]
+  | c == '4' = [('4', 4)]
+  | c == '3' = [('3', 4)]
+  | c == '2' = [('2', 4)]
+  | c == '1' = [('2', 1)]
+
+cellPhonesDead :: DaPhone -> String -> [(Digit, Presses)]
+cellPhonesDead dp s = concat (map (reverseTaps dp) s)
+
+fingerTaps :: [(Digit, Presses)] -> Presses
+fingerTaps = foldr f 0
+    where f (_, p) acc = p + acc
+
+mostPopularLetter :: String -> Char
+mostPopularLetter c = fst $ head (sortBy (\(_, x1) (_, x2) -> compare x2 x1) $ foldr foldF [] c)
+    where foldF c [] = [(c, 1)]
+          foldF c ((x, n):xs)
+            | c == x    = (x, n + 1) :  xs
+            | otherwise = (x, n) : (foldF c xs)
+
+coolestLtr :: [String] -> Char
+coolestLtr = mostPopularLetter . concat
+
+coolestWord :: [String] -> String
+coolestWord c = fst $ head (sortBy (\(_, x1) (_, x2) -> compare x2 x1) $ foldr foldF [] (words (concat c)))
+    where foldF c [] = [(c, 1)]
+          foldF c ((x, n):xs)
+            | c == x    = (x, n + 1) :  xs
+            | otherwise = (x, n) : (foldF c xs)

Haskell-book/11/Programmer.hs

@@ -0,0 +1,40 @@
+module Programmer where
+
+data OperatingSystem = GnuPlusLinux
+                     | OpenBSDPlusNevermindJustBSDStill
+                     | Mac
+                     | Windows
+                     deriving (Eq, Show)
+
+data ProgLang = Haskell
+              | Agda
+              | Idris
+              | PureScript
+              deriving (Eq, Show)
+
+data Programmer = Programmer { os :: OperatingSystem
+                             , lang :: ProgLang }
+                  deriving (Eq, Show)
+
+allOperatingSystems :: [OperatingSystem]
+allOperatingSystems =
+    [ GnuPlusLinux
+    , OpenBSDPlusNevermindJustBSDStill
+    , Mac
+    , Windows
+    ]
+
+allLanguages :: [ProgLang]
+allLanguages =
+    [ Haskell
+    , Agda
+    , Idris
+    , PureScript
+    ]
+
+allProgrammers :: [Programmer]
+allProgrammers = do
+    o <- allOperatingSystems
+    l <- allLanguages
+    return Programmer { os = o
+                      , lang = l }

Haskell-book/11/TooMany.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+module TooMany where
+
+newtype Goats = Goats Int deriving (Eq, Show, TooMany)
+
+newtype Cows = Cows Int deriving (Eq, Show)
+
+class TooMany a where
+    tooMany :: a -> Bool
+
+instance TooMany Int where
+    tooMany n = n > 42
+
+instance TooMany (Int, String) where
+    tooMany (n, _) = n > 42

Haskell-book/11/Vehicle.hs

@@ -0,0 +1,40 @@
+module Vehicle where
+
+data Price = Price Integer deriving (Eq, Show)
+
+data Size = Size Integer deriving (Eq, Show)
+
+data Manufacturer = Mini
+                  | Mazda
+                  | Tata
+                  deriving (Eq, Show)
+
+data Airline = PapuAir
+             | CatapultsR'Us
+             | TakeYourChancesUnited
+             deriving (Eq, Show)
+
+data Vehicle = Car Manufacturer Price
+             | Plane Airline Size
+             deriving (Eq, Show)
+
+myCar = Car Mini (Price 14000)
+urCar = Car Mazda (Price 20000)
+clownCar = Car Tata (Price 7000)
+doge = Plane PapuAir (Size 1234)
+
+isCar :: Vehicle -> Bool
+isCar (Car _ _) = True
+isCar _         = False
+
+isPlane :: Vehicle -> Bool
+isPlane (Plane _ _) = True
+isPlane _           = False
+
+areCars :: [Vehicle] -> [Bool]
+areCars = map isCar
+
+getManu :: Vehicle -> Manufacturer
+getManu (Car m _) = m
+
+data Example = MakeExample Int deriving Show