Add remaining haskell book exercises

4 files changed, 184 insertions, 0 deletions

diff --git a/Haskell-book/22/Ash.hs b/Haskell-book/22/Ash.hs
new file mode 100644
index 0000000..d3bf585
--- /dev/null
+++ b/Haskell-book/22/Ash.hs
@@ -0,0 +1,7 @@
+module Ask where
+
+newtype Reader r a =
+    Reader { runReader :: r -> a }
+
+ask :: Reader a a
+ask = Reader id
diff --git a/Haskell-book/22/Reader.hs b/Haskell-book/22/Reader.hs
new file mode 100644
index 0000000..e50b623
--- /dev/null
+++ b/Haskell-book/22/Reader.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE InstanceSigs #-}
+module Reader where
+
+import Control.Applicative (liftA2)
+
+newtype Reader r a =
+    Reader { runReader :: r -> a }
+
+myLiftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
+myLiftA2 f x y = f <$> x <*> y
+
+asks :: (r -> a) -> Reader r a
+asks f = Reader f
+
+instance Functor (Reader r) where
+    fmap f (Reader x) = Reader $ f . x
+
+instance Applicative (Reader r) where
+    pure :: a -> Reader r a
+    pure a = Reader $ \x -> a
+    (<*>) :: Reader r (a -> b) -> Reader r a -> Reader r b
+    (Reader rab) <*> (Reader ra) = Reader $ \r -> rab r (ra r)
+
+instance Monad (Reader r) where
+    return = pure
+    (>>=) :: Reader r a -> (a -> Reader r b) -> Reader r b
+    (Reader ra) >>= aRb = Reader $ \r -> runReader (aRb (ra r)) r
+
+newtype HumanName = HumanName String deriving (Eq, Show)
+newtype DogName = DogName String deriving (Eq, Show)
+newtype Address = Address String deriving (Eq, Show)
+
+data Person = Person { humanName :: HumanName
+                     , dogName :: DogName
+                     , address :: Address
+                     } deriving (Eq, Show)
+
+data Dog = Dog { dogsName :: DogName
+               , dogsAddress :: Address
+               } deriving (Eq, Show)
+
+pers :: Person
+pers = Person (HumanName "Big Bird")
+              (DogName "Barkley")
+              (Address "Sesame Street")
+
+chris :: Person
+chris = Person (HumanName "Chris Allen")
+               (DogName "Papu")
+               (Address "Austin")
+
+getDog :: Person -> Dog
+getDog p = Dog (dogName p) (address p)
+
+getDogR :: Person -> Dog
+getDogR = Dog <$> dogName <*> address
+
+getDogR' :: Person -> Dog
+getDogR' = liftA2 Dog dogName address
+
+getDogRM :: Person -> Dog
+getDogRM = dogName >>= (\x -> address >>= \y -> return $ Dog x y)
diff --git a/Haskell-book/22/ReaderPractice.hs b/Haskell-book/22/ReaderPractice.hs
new file mode 100644
index 0000000..e530d20
--- /dev/null
+++ b/Haskell-book/22/ReaderPractice.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module ReaderPractice where
+
+import Control.Applicative
+import Data.Maybe (Maybe(..))
+import Prelude ( zip
+               , foldr
+               , ($)
+               , flip
+               , Integer(..)
+               , (==)
+               , Eq
+               , otherwise
+               , undefined
+               , (+)
+               , Num
+               , (<)
+               , (>)
+               , (&&)
+               , Bool(..)
+               , print
+               , sequenceA
+               , IO(..)
+               , fmap
+               , even
+               , Integral )
+
+x = [1, 2, 3]
+y = [4, 5, 6]
+z = [7, 8, 9]
+
+lookup :: Eq a => a -> [(a, b)] -> Maybe b
+lookup v l = foldr f Nothing l
+    where f _ (Just x) = Just x
+          f (x, y) Nothing
+            | x == v = Just y
+            | otherwise = Nothing
+
+-- zip x and y using 3 as the lookup key
+xs :: Maybe Integer
+xs = lookup 3 (zip x y)
+
+-- zip y and z using 6 as the lookup key
+ys :: Maybe Integer
+ys = lookup 6 (zip y z)
+
+-- zip x and y using 4 as the lookup key
+zs :: Maybe Integer
+zs = lookup 4 $ zip x y
+
+z' :: Integer -> Maybe Integer
+z' = flip lookup $ zip x z
+
+x1 :: Maybe (Integer, Integer)
+x1 = Just (,) <*> xs <*> ys
+
+x2 :: Maybe (Integer, Integer)
+x2 = Just (,) <*> ys <*> zs
+
+x3 :: Integer -> (Maybe Integer, Maybe Integer)
+x3 n = (z' n, z' n)
+
+uncurry :: (a -> b -> c) -> (a, b) -> c
+uncurry f (x, y) = f x y
+
+summed :: Num c => (c, c) -> c
+summed = uncurry (+)
+
+bolt :: Integer -> Bool
+bolt = (&&) <$> (> 3) <*> (< 8)
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe x (Just y) = y
+fromMaybe x Nothing = x
+
+sequA :: Integral a => a -> [Bool]
+sequA m = sequenceA [(>3), (<8), even] m
+
+s' :: Maybe Integer
+s' = summed <$> ((,) <$> xs <*> ys)
+
+main :: IO ()
+main = do
+    print $ sequenceA [Just 3, Just 2, Just 1]
+    print $ sequenceA [x, y]
+    print $ sequenceA [xs, ys]
+    print $ summed <$> ((,) <$> xs <*> ys)
+    print $ fmap summed ((,) <$> xs <*> zs)
+    print $ bolt 7
+    print $ fmap bolt z
+    print $ sequenceA [(> 3), (< 8), even] 7
+    print $ foldr (&&) True $ sequA $ fromMaybe 0 s'
+    print $ sequA $ fromMaybe 0 s'
+    print $ bolt $ fromMaybe 0 s'
diff --git a/Haskell-book/22/WarmingUp.hs b/Haskell-book/22/WarmingUp.hs
new file mode 100644
index 0000000..b8dd194
--- /dev/null
+++ b/Haskell-book/22/WarmingUp.hs
@@ -0,0 +1,21 @@
+module WarmingUp where
+
+import Data.Char
+
+cap :: [Char] -> [Char]
+cap xs = map toUpper xs
+
+rev :: [Char] -> [Char]
+rev xs = reverse xs
+
+composed :: [Char] -> [Char]
+composed = cap . rev
+
+fmapped :: [Char] -> [Char]
+fmapped = fmap cap rev
+
+tupled :: [Char] -> ([Char], [Char])
+tupled = (,) <$> composed <*> fmapped
+
+tupled' :: [Char] -> ([Char], [Char])
+tupled' = composed >>= (\x -> fmapped >>= (\y -> return (x, y)))