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) }
```
		
	
			
		
			
				
	
	
		
			149 lines
		
	
	
	
		
			3.1 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			149 lines
		
	
	
	
		
			3.1 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| 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
 |