Add solutions to the state chapter

Author: BoeingX

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/Boei
 
 dependencies:
 - base >= 4.7 && < 5
+- transformers
 - hspec
 - QuickCheck
 - checkers

src/State/ChapterExercises/Exercises.hs

@@ -0,0 +1,38 @@
+module State.ChapterExercises.Exercises where
+
+newtype State s a = State { runState :: s -> (a, s) }
+
+instance Functor (State s) where
+    fmap f (State g) = State $ \x -> let (a, s) = g x in (f a, s)
+
+instance Applicative (State s) where
+    pure a = State $ (,) a
+    (State f) <*> (State g) = State $ \s -> let (ab, s') = f s
+                                                (a, s'') = g s
+                                            in (ab a, s'')
+
+instance Monad (State s) where
+    return = pure
+    (State f) >>= g = State $ \x -> let (a, s) = f x
+                                        State h  = g a
+                                    in h s
+
+-- Question 1
+get :: State s s
+get = State $ \s -> (s, s)
+
+-- Question 2
+put :: s -> State s ()
+put s = State $ const ((), s)
+
+-- Question 3
+exec :: State s a -> s -> s
+exec (State sa) = snd . sa
+
+-- Question 4
+eval :: State s a -> s -> a
+eval (State sa) = fst . sa
+
+-- Question 5
+modify :: (s -> s) -> State s ()
+modify f = State $ \s -> ((), f s)

src/State/GetACodingJobWithOneWierdTrick/FizzbuzzDifferently.hs

@@ -0,0 +1,23 @@
+module State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferently where
+
+import Control.Monad
+import Control.Monad.Trans.State
+
+fizzBuzz :: Integer -> String
+fizzBuzz n 
+  | n `mod` 15 == 0 = "FizzBuzz"
+  | n `mod` 5 == 0  = "Fizz"
+  | n `mod` 3 == 0  = "Buzz"
+  | otherwise       = show n
+
+fizzbuzzList :: [Integer] -> [String]
+fizzbuzzList list = execState (mapM_ addResult list) []
+
+addResult :: Integer -> State [String] ()
+addResult n = do
+    xs <- get
+    let result = fizzBuzz n
+    put (result : xs)
+
+fizzbuzzFromTo :: Integer -> Integer -> [String]
+fizzbuzzFromTo a b = fizzbuzzList [b, b-1 ..a]

src/State/ThrowDown/Exercises.hs

@@ -0,0 +1,42 @@
+module State.ThrowDown.Exercises where
+
+import System.Random
+
+data Die =
+    DieOne
+  | DieTwo
+  | DieThree
+  | DieFour
+  | DieFive
+  | DieSix
+  deriving (Eq, Show)
+
+intToDie :: Int -> Die
+intToDie n =
+    case n of
+        1 -> DieOne
+        2 -> DieTwo
+        3 -> DieThree
+        4 -> DieFour
+        5 -> DieFive
+        6 -> DieSix
+        -- Use this tactic _extremely_ sparingly.
+        x -> error $ "intToDie got non 1-6 integer: " ++ show x
+
+-- Exercise 1
+rollsToGetN :: Int -> StdGen -> Int
+rollsToGetN limit = go 0 0
+    where go :: Int -> Int -> StdGen -> Int
+          go sum count gen
+            | sum >= limit = count
+            | otherwise = go (sum + die) (count + 1) nextGen
+                where (die, nextGen) = randomR (1, 6) gen
+
+-- Exercise 2
+rollsCountLogged :: Int -> StdGen -> (Int, [Die])
+rollsCountLogged limit = go 0 0 []
+    where go :: Int -> Int -> [Die] -> StdGen -> (Int, [Die])
+          go sum count dies gen
+            | sum >= limit = (count, dies)
+            | otherwise = go (sum + die) (count + 1) (intToDie die : dies) nextGen
+                where (die, nextGen) = randomR (1, 6) gen

src/State/WriteStateForYourself/Exercise.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE InstanceSigs #-}
+module State.WriteStateForYourself.Exercise where
+
+newtype Moi s a = Moi { runMoi :: s -> (a, s) }
+
+instance Functor (Moi s) where
+    fmap :: (a -> b) -> Moi s a -> Moi s b
+    fmap f (Moi g) = Moi $ \x -> let (a, s) = g x in (f a, s)
+
+instance Applicative (Moi s) where
+    pure :: a -> Moi s a
+    pure a = Moi $ (,) a
+    (Moi f) <*> (Moi g) = Moi $ \s -> let (ab, s') = f s
+                                          (a, s'') = g s
+                                      in (ab a, s'')
+
+instance Monad (Moi s) where
+    return = pure
+    (>>=) :: Moi s a -> (a -> Moi s b) -> Moi s b
+    (Moi f) >>= g = Moi $ \x -> let (a, s) = f x
+                                    Moi h  = g a
+                                in h s

test/State/ChapterExercises/ExercisesSpec.hs

@@ -0,0 +1,28 @@
+module State.ChapterExercises.ExercisesSpec where
+
+import Test.Hspec
+import State.ChapterExercises.Exercises
+
+spec :: Spec
+spec = do
+    describe "Test get" $ do
+        it "runState get \"curryIsAmaze\"" $ do
+            runState get "curryIsAmaze" `shouldBe` ("curryIsAmaze","curryIsAmaze")
+    describe "Test put" $ do
+        it "runState (put \"blah\") \"woot\"" $ do
+            runState (put "blah") "woot" `shouldBe` ((),"blah")
+    describe "Test exec" $ do
+        it "exec (put \"wilma\") \"daphne\"" $ do
+            exec (put "wilma") "daphne" `shouldBe` "wilma"
+        it "exec get \"scooby papu\"" $ do
+            exec get "scooby papu" `shouldBe` "scooby papu"
+    describe "Test eval" $ do
+        it "eval get \"bunnicula\"" $ do
+            eval get "bunnicula" `shouldBe` "bunnicula"
+        it "eval get \"stake a bunny\"" $ do
+            eval get "stake a bunny" `shouldBe` "stake a bunny"
+    describe "Test modify" $ do
+        it "runState (modify (+1)) 0" $ do
+            runState (modify (+1)) 0 `shouldBe` ((),1)
+        it "runState (modify (+1) >> modify (+1)) 0" $ do
+            runState (modify (+1) >> modify (+1)) 0 `shouldBe` ((),2 :: Int)

test/State/GetACodingJobWithOneWierdTrick/FizzbuzzDifferentlySpec.hs

@@ -0,0 +1,10 @@
+module State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferentlySpec where
+
+import Test.Hspec
+import State.GetACodingJobWithOneWierdTrick.FizzbuzzDifferently
+
+spec :: Spec
+spec = do
+    describe "Test fizzbuzzFromTo" $ do
+        it "fizzbuzzFromTo 1 15" $ do
+            fizzbuzzFromTo 1 15 `shouldBe` ["1", "2", "Buzz", "4", "Fizz", "Buzz", "7", "8", "Buzz", "Fizz", "11", "Buzz", "13", "14", "FizzBuzz"]

test/State/ThrowDown/ExercisesSpec.hs

@@ -0,0 +1,14 @@
+module State.ThrowDown.ExercisesSpec where
+
+import System.Random
+import Test.Hspec
+import State.ThrowDown.Exercises
+
+spec :: Spec
+spec = do
+    describe "Test rollsToGetN" $ do
+        it "roolsToGetN 20" $ do
+            rollsToGetN 20 (mkStdGen 0) `shouldBe` 5
+    describe "Test rollsCountLogged" $ do
+        it "rollsCountLogged 20" $ do
+            rollsCountLogged 20 (mkStdGen 0) `shouldBe` (5, [DieFive, DieOne, DieFour, DieSix, DieSix])

test/State/WriteStateForYourself/ExerciseSpec.hs

@@ -0,0 +1,10 @@
+module State.WriteStateForYourself.ExerciseSpec where
+
+import Test.Hspec
+import State.WriteStateForYourself.Exercise
+
+spec :: Spec
+spec = do
+    describe "Test Functor implementation" $ do
+        it "runMoi ((+1) <$> (Moi $ \\s -> (0, s))) 0" $ do
+            runMoi ((+1) <$> (Moi $ \s -> (0, s))) 0 `shouldBe` (1, 0)