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:
parent
c4fe3c92c7
commit
ee1aeee5f8
2 changed files with 242 additions and 0 deletions
149
scratch/haskell-programming-from-first-principles/reader.hs
Normal file
149
scratch/haskell-programming-from-first-principles/reader.hs
Normal 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
|
Loading…
Add table
Add a link
Reference in a new issue