diff options
author | William Carroll <wpcarro@gmail.com> | 2020-07-01T09·42+0100 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-07-01T09·42+0100 |
commit | ee1aeee5f8536c35fb9f1580174facd33698ad50 (patch) | |
tree | 22a001789253ae867845e72631ce20553d949f68 /scratch/haskell-programming-from-first-principles/state.hs | |
parent | c4fe3c92c7e18a58630edc2a5d9a334075af985f (diff) |
Complete exercises for Reader and State chapters
It's beautiful how State is just Reader that returns a tuple of (a, r) instead of just a, allowing you to modify the environment (i.e. state). ```haskell newtype Reader r a = Reader { runReader :: r -> a } newtype State s a = State { runState :: s -> (a, s) } ```
Diffstat (limited to 'scratch/haskell-programming-from-first-principles/state.hs')
-rw-r--r-- | scratch/haskell-programming-from-first-principles/state.hs | 93 |
1 files changed, 93 insertions, 0 deletions
diff --git a/scratch/haskell-programming-from-first-principles/state.hs b/scratch/haskell-programming-from-first-principles/state.hs new file mode 100644 index 000000000000..f63e0ecdf11c --- /dev/null +++ b/scratch/haskell-programming-from-first-principles/state.hs @@ -0,0 +1,93 @@ +module StateScratch where + +-------------------------------------------------------------------------------- +import System.Random +-- import Control.Monad.Trans.State +import Data.Function ((&)) + +import qualified Control.Applicative as Ap +import qualified Control.Monad as M +-------------------------------------------------------------------------------- + +data Die + = DieOne + | DieTwo + | DieThree + | DieFour + | DieFive + | DieSix + deriving (Eq, Show) + +intToDie :: Integer -> Maybe Die +intToDie 1 = Just DieOne +intToDie 2 = Just DieTwo +intToDie 3 = Just DieThree +intToDie 4 = Just DieFour +intToDie 5 = Just DieFive +intToDie 6 = Just DieSix +intToDie _ = Nothing + +rollDie :: Moi StdGen Die +rollDie = do + (n, s) <- randomR (1, 6) + case intToDie n of + Just d -> pure (d, s) + Nothing -> pure (DieOne, s) + +rollsToGetN :: Integer -> StdGen -> [Die] +rollsToGetN n g = go 0 [] g + where + go sum result gen + | sum >= n = result + | otherwise = + let (dice, nextGen) = randomR (1, 6) gen + in case intToDie dice of + Nothing -> go (sum + dice) result nextGen + Just d -> go (sum + dice) (d : result) nextGen + +-------------------------------------------------------------------------------- + +newtype Moi s a = Moi { runMoi :: s -> (a, s) } + +instance Functor (Moi s) where + fmap f (Moi run) = + Moi $ \s -> let (x, t) = run s + in (f x, t) + +instance Applicative (Moi s) where + pure x = Moi $ \s -> (x, s) + (Moi f) <*> (Moi run) = + Moi $ \s -> let (g, t) = f s + (x, u) = run t + in (g x, u) + +instance Monad (Moi s) where + (Moi run1) >>= f = + Moi $ \s -> let (x, t) = run1 s + (Moi run2) = f x + in run2 t + +-------------------------------------------------------------------------------- + +fizzBuzz :: Integer -> String +fizzBuzz n | n `mod` 15 == 0 = "FizzBuzz" + | n `mod` 5 == 0 = "Buzz" + | n `mod` 3 == 0 = "Fizz" + | otherwise = show n + +-------------------------------------------------------------------------------- + +get :: Moi s s +get = Moi $ \s -> (s, s) + +put :: s -> Moi s () +put x = Moi $ \s -> ((), x) + +exec :: Moi s a -> s -> s +exec (Moi run) x = x & run & snd + +eval :: Moi s a -> s -> a +eval (Moi run) x = x & run & fst + +modify :: (s -> s) -> Moi s () +modify f = Moi $ \s -> ((), f s) |