2 files changed, 242 insertions, 0 deletions
diff --git a/scratch/haskell-programming-from-first-principles/reader.hs b/scratch/haskell-programming-from-first-principles/reader.hs
new file mode 100644
index 000000000000..7cb7b4a1bbc1
--- /dev/null
+++ b/scratch/haskell-programming-from-first-principles/reader.hs
@@ -0,0 +1,149 @@
+module Reader where
+
+import Data.Char
+import Data.Function ((&))
+import Data.Functor ((<&>))
+import qualified Control.Applicative as A
+import qualified Data.Maybe as MB
+
+cap :: String -> String
+cap xs = xs <&> toUpper
+
+rev :: String -> String
+rev = reverse
+
+compose :: String -> String
+compose xs = xs & rev . cap
+
+fmapped :: String -> String
+fmapped xs = xs & rev <$> cap
+
+tupled :: String -> (String, String)
+tupled xs = A.liftA2 (,) cap rev $ xs
+
+tupled' :: String -> (String, String)
+tupled' = do
+  capResult <- cap
+  revResult <- rev
+  pure (revResult, capResult)
+
+--------------------------------------------------------------------------------
+
+newtype Reader r a = Reader { runReader :: r -> a }
+
+ask :: Reader a a
+ask = Reader id
+
+--------------------------------------------------------------------------------
+
+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 =
+  A.liftA2 Dog dogName address
+
+--------------------------------------------------------------------------------
+
+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 a) where
+  fmap f (Reader ab) = Reader $ f . ab
+
+instance Applicative (Reader a) where
+  pure x = Reader $ \_ -> x
+  (Reader rab) <*> (Reader ra) = Reader $ do
+    ab <- rab
+    fmap ab ra
+
+--------------------------------------------------------------------------------
+
+instance Monad (Reader r) where
+  return = pure
+  -- (>>=) :: Reader r a -> (a -> Reader r b) -> Reader r b
+  (Reader x) >>= f = undefined
+
+--------------------------------------------------------------------------------
+
+x = [1..3]
+y = [4..6]
+z = [7..9]
+
+xs :: Maybe Integer
+xs = zip x y & lookup 3
+
+ys :: Maybe Integer
+ys = zip y z & lookup 6
+
+zs :: Maybe Integer
+zs = zip x y & lookup 4
+
+z' :: Integer -> Maybe Integer
+z' n = zip x y & lookup n
+
+x1 :: Maybe (Integer, Integer)
+x1 = A.liftA2 (,) xs ys
+
+x2 :: Maybe (Integer, Integer)
+x2 = A.liftA2 (,) ys zs
+
+x3 :: Integer -> (Maybe Integer, Maybe Integer)
+x3 n = (z' n, z' n)
+
+summed :: Num a => (a, a) -> a
+summed (x, y) = x + y
+
+bolt :: Integer -> Bool
+bolt x = x > 3 && x < 8
+
+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 $ bolt 7
+  print $ bolt <$> z
+  print $ sequenceA [(>3), (<8) ,even] 7
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)