subtree(users/wpcarro): docking briefcase at '24f5a642' r/3226

git-subtree-dir: users/wpcarro
git-subtree-mainline: 464bbcb15c09813172c79820bcf526bb10cf4208
git-subtree-split: 24f5a642af3aa1627bbff977f0a101907a02c69f
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789

1 files changed, 93 insertions, 0 deletions

diff --git a/users/wpcarro/scratch/haskell-programming-from-first-principles/state.hs b/users/wpcarro/scratch/haskell-programming-from-first-principles/state.hs
new file mode 100644
index 000000000000..f63e0ecdf11c
--- /dev/null
+++ b/users/wpcarro/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)