{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Lessons.Lesson09 where
import Lessons.Lesson08(Parser(..), threeLetters)
import Control.Applicative
import Control.Monad.Trans.State.Strict (State, StateT, get, put, runState, runStateT)
import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Control.Monad.Trans.Class(lift)
import Control.Monad.IO.Class(liftIO)
import Control.Monad
import Data.Foldable
queryAge :: String -> IO Integer
queryAge :: String -> IO Integer
queryAge String
name = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"What is your age, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> IO String -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getLine
instance Monad Parser where
(>>=) :: Parser a -> (a -> Parser b) -> Parser b
Parser a
ma >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
mf = (String -> Either String (b, String)) -> Parser b
forall a. (String -> Either String (a, String)) -> Parser a
Parser ((String -> Either String (b, String)) -> Parser b)
-> (String -> Either String (b, String)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \String
input ->
case Parser a -> String -> Either String (a, String)
forall a. Parser a -> String -> Either String (a, String)
runParser Parser a
ma String
input of
Left String
e1 -> String -> Either String (b, String)
forall a b. a -> Either a b
Left String
e1
Right (a
a, String
r1) ->
case Parser b -> String -> Either String (b, String)
forall a. Parser a -> String -> Either String (a, String)
runParser (a -> Parser b
mf a
a) String
r1 of
Left String
e2 -> String -> Either String (b, String)
forall a b. a -> Either a b
Left String
e2
Right (b
b, String
r2) -> (b, String) -> Either String (b, String)
forall a b. b -> Either a b
Right (b
b, String
r2)
threeThreeLetterWords:: Parser [String]
threeThreeLetterWords :: Parser [String]
threeThreeLetterWords = do
String
a <- Parser String
threeLetters
String
b <- Parser String
threeLetters
String
c <- Parser String
threeLetters
[String] -> Parser [String]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
a, String
b, String
c]
stateful :: State String Int
stateful :: State String Int
stateful = do
String
value <- StateT String Identity String
forall (m :: * -> *) s. Monad m => StateT s m s
get
String -> StateT String Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put String
"I am a new state"
Int -> State String Int
forall a. a -> StateT String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> State String Int) -> Int -> State String Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
value
combined :: State String (Int, Int)
combined :: State String (Int, Int)
combined = do
Int
a <- State String Int
stateful
Int
b <- State String Int
stateful
(Int, Int) -> State String (Int, Int)
forall a. a -> StateT String Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
a, Int
b)
combined' :: State String (Int, Int)
combined' :: State String (Int, Int)
combined' = (,) (Int -> Int -> (Int, Int))
-> State String Int -> StateT String Identity (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State String Int
stateful StateT String Identity (Int -> (Int, Int))
-> State String Int -> State String (Int, Int)
forall a b.
StateT String Identity (a -> b)
-> StateT String Identity a -> StateT String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State String Int
stateful
combined'' :: State String (Int, Int)
combined'' :: State String (Int, Int)
combined'' = (Int -> Int -> (Int, Int))
-> State String Int -> State String Int -> State String (Int, Int)
forall a b c.
(a -> b -> c)
-> StateT String Identity a
-> StateT String Identity b
-> StateT String Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) State String Int
stateful State String Int
stateful