Add solutions to the folding lists chapter

Author: BoeingX

package.yaml

@@ -36,6 +36,7 @@ dependencies:
 - split
 - scotty
 - wai
+- time
 
 library:
   source-dirs: src

src/FoldingLists/ChapterExercises/RewritingFunctionsUsingFolds.hs

@@ -0,0 +1,42 @@
+module FoldingLists.ChapterExercises.RewritingFunctionsUsingFolds where
+
+myOr :: [Bool] -> Bool
+myOr = foldr (||) False
+
+myAny :: (a -> Bool) -> [a] -> Bool
+myAny f = foldr go True
+    where go x = (&&) (f x)
+
+myElem :: Eq a => a -> [a] -> Bool
+myElem x = any ((==) x)
+
+myReverse :: [a] -> [a]
+myReverse = foldl (flip (:)) []
+
+myMap :: (a -> b) -> [a] -> [b]
+myMap f = foldr (\x acc -> f x : acc) []
+
+myFilter :: (a -> Bool) -> [a] -> [a]
+myFilter f = foldr (\x acc -> if f x then x : acc else acc) []
+
+squish :: [[a]] -> [a]
+squish = foldr (++) []
+
+squishMap :: (a -> [b]) -> [a] -> [b]
+squishMap f = foldr (\x acc -> f x ++ acc) []
+
+squishAgain :: [[a]] -> [a]
+squishAgain = squishMap id
+
+myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
+myMaximumBy f = foldr1 go
+    where go x acc = case f x acc of
+                       GT -> x
+                       otherwise -> acc
+
+myMinimumBy :: (a -> a -> Ordering) -> [a] -> a
+myMinimumBy f = foldr1 go
+    where go x acc = case f x acc of
+                       LT -> x
+                       otherwise -> acc
+

src/FoldingLists/ChapterExercises/WarmUpAndReview.hs

@@ -0,0 +1,24 @@
+module FoldingLists.ChapterExercises.WarmUpAndReview where
+
+-- Question 1
+stops = "pbtdkg"
+vowels = "aeiou"
+
+stopVowelStop :: [(Char, Char, Char)]
+stopVowelStop = [(x, y, z) | x <- stops, y <- vowels, z <- stops]
+
+stopVowelStop' :: [(Char, Char, Char)]
+stopVowelStop' = filter go stopVowelStop
+    where go ('p', _, _) = True
+          go _ = False
+
+-- Question 2
+-- This function calculates the average word length in a sentence
+seekritFunc x = 
+    div (sum (map length (words x)))
+        (length (words x))
+
+-- Question 3
+seekritFunc' x = y / z
+    where y = fromIntegral $ sum $ map length $ words x
+          z = fromIntegral $ length $ words x

src/FoldingLists/FoldLeft/IntermissionExercises.md

@@ -0,0 +1,41 @@
+## Question 1
+
+`foldr (*) 1 [1..5]` will return the same result as
+`b) foldl (flip (*)) 1 [1..5]` and
+`c) foldl (*) 1 [1..5]`.
+
+## Question 2
+
+```haskell
+foldl (flip (*)) 1 [1..3]
+flip (*) (flip (*) (flip (*) 1 1) 2) 3
+flip (*) (flip (*) (1 * 1) 2) 3
+flip (*) (flip (*) 1 2) 3
+flip (*) (2 * 1) 3
+flip (*) 2 3
+3 * 2
+6
+```
+
+## Question 3
+
+One difference between `foldr` and `foldl` is
+`c) foldr , but not foldl , associates to the right`.
+
+## Question 4
+
+Folds are catamorphisms,
+which means they are generally used to
+`a) reduce structure`.
+
+## Question 5
+
+a) foldr (++) "" ["woot", "WOOT", "woot"]
+b) foldr max 'a' "fear is the little death"
+c) foldr (&&) True [False, True]
+d) foldr (||) False [False, True]
+e) foldl (\acc x -> acc ++ show x) "" [1..5]
+f) foldl const 'a' [1..5]
+g) foldl const 0 "tacos"
+h) foldr (flip const) 0 "burritos"
+i) foldr (flip const) 'z' [1..5]

src/FoldingLists/HowToWriteFoldFunctions/IntermissionExercises.hs

@@ -0,0 +1,39 @@
+module FoldingLists.HowToWriteFoldFunctions.IntermissionExercises where
+
+import Data.List
+import Data.Ord
+import Data.Time
+
+data DatabaseItem = DbString String
+                  | DbNumber Integer
+                  | DbDate UTCTime
+                  deriving (Eq, Ord, Show)
+
+-- Question 1
+filterDbDate :: [DatabaseItem] -> [UTCTime]
+filterDbDate = foldr go []
+    where go (DbDate t) acc = t : acc
+          go _ acc = acc
+
+-- Question 2
+filterDbNumber :: [DatabaseItem] -> [Integer]
+filterDbNumber = foldr go []
+    where go (DbNumber x) acc = x : acc
+          go _ acc = acc
+
+-- Question 3
+-- Descending sort https://ro-che.info/articles/2016-04-02-descending-sort-haskell
+mostRecent :: [DatabaseItem] -> UTCTime
+mostRecent = head . sortOn Down . filterDbDate
+
+-- Question 4
+sumDb :: [DatabaseItem] -> Integer
+sumDb = sum . filterDbNumber
+
+-- Question 5
+avgDb :: [DatabaseItem] -> Double
+avgDb = avg . filterDbNumber
+    where avg :: [Integer] -> Double
+          avg xs = s / l
+              where s = fromIntegral $ sum xs
+                    l = fromIntegral $ length xs

src/FoldingLists/Scans/ScansExercises.hs

@@ -0,0 +1,18 @@
+module FoldingLists.Scans.ScansExercises where
+
+import Data.List
+
+-- Question 1
+fibs :: [Integer]
+fibs = scanl (+) 1 fibs
+
+fibs' :: [Integer]
+fibs' = take 20 fibs
+
+-- Question 2
+fibs'' :: [Integer]
+fibs'' = takeWhile (<100) fibs
+
+-- Question 3
+factorial :: [Integer]
+factorial = scanl (*) 1 [2..]

test/FoldingLists/ChapterExercises/RewritingFunctionsUsingFoldsSpec.hs

@@ -0,0 +1,41 @@
+module FoldingLists.ChapterExercises.RewritingFunctionsUsingFoldsSpec where
+
+import Test.Hspec
+import FoldingLists.ChapterExercises.RewritingFunctionsUsingFolds
+
+spec :: Spec
+spec = do
+    describe "Test myAny" $ do
+        it "myAny even [1, 3, 5]" $ do
+            myAny even [1, 3, 5] `shouldBe` False
+        it "myAny odd [1, 3, 5]" $ do
+            myAny odd [1, 3, 5] `shouldBe` True
+    describe "Test myElem" $ do
+        it "myElem 1 [1..10]" $ do
+            myElem 1 [1..10] `shouldBe` True
+        it "myElem 1 [2..10]" $ do
+            myElem 1 [2..10] `shouldBe` False
+    describe "Test myReverse" $ do
+        it "myReverse \"blah\"" $ do
+            myReverse "blah" `shouldBe` "halb"
+        it "myReverse [1..5]" $ do
+            myReverse [1..5] `shouldBe` [5,4,3,2,1]
+    describe "Test squishMap" $ do
+        it "squishMap (\\x -> [1, x, 3]) [2]" $ do
+            squishMap (\x -> [1, x, 3]) [2] `shouldBe` [1,2,3]
+        it "squishMap (\\x -> \"WO \" ++ [x] ++ \" OT \") \"blah\"" $ do
+            squishMap (\x -> "WO " ++ [x] ++ " OT ") "blah" `shouldBe` "WO b OT WO l OT WO a OT WO h OT "
+    describe "Test myMaximumBy" $ do
+        it "myMaximumBy (\\_ _ -> GT) [1..10]" $ do
+            myMaximumBy (\_ _ -> GT) [1..10] `shouldBe` 1
+        it "myMaximumBy (\\_ _ -> LT) [1..10]" $ do
+            myMaximumBy (\_ _ -> LT) [1..10] `shouldBe` 10
+        it "myMaximumBy compare [1..10]" $ do
+            myMaximumBy compare [1..10] `shouldBe` 10
+    describe "Test myMinimumBy" $ do
+        it "myMinimumBy (\\_ _ -> GT) [1..10]" $ do
+            myMinimumBy (\_ _ -> GT) [1..10] `shouldBe` 10
+        it "myMinimumBy (\\_ _ -> LT) [1..10]" $ do
+            myMinimumBy (\_ _ -> LT) [1..10] `shouldBe` 1
+        it "myMinimumBy compare [1..10]" $ do
+            myMinimumBy compare [1..10] `shouldBe` 1

test/FoldingLists/HowToWriteFoldFunctions/IntermissionExercisesSpec.hs

@@ -0,0 +1,38 @@
+module FoldingLists.HowToWriteFoldFunctions.IntermissionExercisesSpec where
+
+import Data.Time
+import Test.Hspec
+
+import FoldingLists.HowToWriteFoldFunctions.IntermissionExercises
+
+theDatabase :: [DatabaseItem]
+theDatabase =
+    [ DbDate (UTCTime
+              (fromGregorian 1911 5 1)
+              (secondsToDiffTime 34123))
+    , DbNumber 9001
+    , DbString "Hello, world!"
+    , DbDate (UTCTime
+              (fromGregorian 1921 5 1)
+              (secondsToDiffTime 34123))
+    ]
+
+spec :: Spec
+spec = do
+    describe "Test filterDbDate" $ do
+        it "filterDbDate theDatabase" $ do
+            let t1 = UTCTime (fromGregorian 1911 5 1) (secondsToDiffTime 34123)
+                t2 = UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123)
+            filterDbDate theDatabase `shouldBe` [t1, t2]
+    describe "Test filterDbNumber" $ do
+        it "filterDbNumber theDatabase" $ do
+            filterDbNumber theDatabase `shouldBe` [9001]
+    describe "Test mostRecent" $ do
+        it "mostRecent theDatabase" $ do
+            mostRecent theDatabase `shouldBe` UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123)
+    describe "Test sumDb" $ do
+        it "sumDb theDatabase" $ do
+            sumDb theDatabase `shouldBe` 9001
+    describe "Test avgDb" $ do
+        it "avgDb theDatabase" $ do
+            avgDb theDatabase `shouldBe` 9001

test/FoldingLists/Scans/ScansExercisesSpec.hs

@@ -0,0 +1,10 @@
+module FoldingLists.Scans.ScansExercisesSpec where
+
+import Test.Hspec
+import FoldingLists.Scans.ScansExercises
+
+spec :: Spec
+spec = do
+    describe "Test factorial" $ do
+        it "take 5 factorial" $ do
+            take 5 factorial `shouldBe` [1, 2, 6, 24, 120]