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) }
```
This commit is contained in:
William Carroll 2020-07-01 10:42:57 +01:00
parent c4fe3c92c7
commit ee1aeee5f8
2 changed files with 242 additions and 0 deletions

View file

@ -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

View file

@ -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)