+
+
+
+Функциональное программирование
+
+
+
+Напоминалочка
+class Functor f where
+ fmap :: (a -> b) -> f a -> f b
class Functor f => Applicative f where
+ (<*>) :: f (a -> b) -> f a -> f b
+ pure :: a -> f a
class Applicative f => Monad f where
+ (>>=) :: f a -> (a -> f b) -> f b
+ return :: a -> f a
+
+
+Either
+data Either a b = Left a | Right b
throwError :: e -> Either e a
+throwError = Left
data PaymentError = InsufficientBalance
+
+pay :: Balance -> Price -> Either PaymentError Balance
+pay balance price = do
+ let newBalance = balance - price
+ when (newBalance < 0) (throwError InsufficientBalance)
+ return newBalance
when :: (Applicative f) => Bool -> f () -> f ()
+when p s = if p then s else pure ()
+
+State
+data State s a = State { runState :: s -> (a, s) }
get :: State s s
+get = State (\s -> (s, s))
+
+put :: s -> State s ()
+put s = State (\_ -> (_, s))
+
+
+getNewId :: State TransactionId TransactionId
+getNewId = do
+ newId <- get
+ put (succ newId)
+ return newId
+
+data Transaction = Transaction
+ { transactionId :: TransactionId,
+ transactionAmount :: Price
+ }
registerPayment :: Price -> State TransactionId Transaction
+registerPayment price = do
+ newId <- getNewId
+ return Transaction
+ { transactionId = newId
+ transactionAmount = price
+ }
+
+
+registerPayment :: Price -> State TransactionId Transaction
+pay :: Balance -> Price -> Either PaymentError Balance
payAndRegister balance price = do
+ newBalance <- pay balance price
+ transacation <- registerPayment price
+ return (newBalance, transaction)
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
-- Такого нет
+(>=>)
+ :: (Monad m, Monad n)
+ => (a -> m b) -> (b -> n c) -> (a -> ? c)
На каждый чих нужно создавать новый тип?
+
+
+
+Мы хотим:
+
+- Отделить эффекты от конкретной монады
+- Получить возможность комбинировать разные эффекты
+
+(И чтобы не надо было на каждый случай новый тип создавать)
+
+
+
+registerPayment :: Price -> State TransactionId Transaction
+pay :: Balance -> Price -> Either PaymentError Balance
registerPayment
+ :: MonadState TransactionId m
+ => Price -> m Transaction
+pay
+ :: MonadError PaymentError m
+ => Balance -> Price -> m Balance
payAndRegister
+ :: (MonadState TransactionId m, MonadError PaymentError m)
+ => Balance -> Price -> m (Balance, Transaction)
+
+
+На самом деле мы хотим чтобы понятие “state” не было привязано к конкретной монаде.
+Мы хотим чтобы “базовые операции” не были привязаны к конкретной монаде.
+-- Было
+get :: State s s
+put :: s -> State s ()
-- Стало
+get :: MonadState s m => m s
+put :: MonadState s m => s -> m ()
+
+
+
+
+class Monad m => MonadState s m where
+ get :: m s
+ put :: s -> m ()
data State s a = State { runState :: s -> (a, s) }
+
+instance MonadState s (State s) where
+ get = State (\s -> (s, s))
+ put s = State (\_ -> ((), s))
getNewId :: MonadState TransactionId m => m TransactionId
+getNewId = do
+ newId <- get
+ put (succ newId)
+ return newId
registerPayment :: Price -> State TransactionId Transaction
+registerPayment price = do
+ newId <- getNewId
+ return Transaction
+ { transactionId = newId
+ transactionAmount = price
+ }
+
+
+MonadError
+class Monad m => MonadError e m where
+ throwError :: e -> m a
+ catchError :: m a -> (e -> m a) -> m a
data Either e a = Left e | Right a
+
+instance MonadError e (Either e) where
+ throwError e = Left e
+
+ catchError (Left e) f = f e
+ catchError (Right a) _ = Right a
+
+
+Мы хотим:
+
+Отделить эффекты от конкретной монады- Получить возможность комбинировать разные эффекты
+
+
+
+
+Начнем с функторов
+data Compose f g a = Compose { getCompose :: f (g a) }
type ErrorStateFunctor a =
+ Compose (Either PaymentError) (State TransactionId) a
-- Compose
+-- { getCompose ::
+-- Either PaymentError (State TransactionId a)
+-- }
instance (Functor f, Functor g) =>Functor (Compose f g) where
+ fmap f (Compose x) = Compose (fmap (fmap f) x)
🎉
+(Applicative тоже можно – можете сами попробовать)
+
+
+
+К монадам!
+instance (Monad f, Monad g) => Monad (Compose f g) where
+ return x = Compose (return (return x))
+ (Compose x) >>= f = ???
😢
+Все равно хочется!
+
+
+
+data Compose f g a = Compose { getCompose :: f (g a) }
Для такого не можем
+data ErrorState e s a =
+ ErrorState { runErrorState :: State s (Either e a) }
А для такого можем!
+(State s (Either e a)) ~ (s -> Either e (a, s))
+
+
+data ErrorState e s a =
+ ErrorState { runErrorState :: State s (Either e a) }
Хочется чтобы можно было не только Either!
+data State s a = State { runState :: s -> (a, s) }
data StateT s m a = StateT { runStateT :: s -> m (a, s) }
instance (Monad m) => Monad (StateT s m) where
+ return a = StateT $ \ s -> return (a, s)
+
+ m >>= f = StateT (\s -> do
+ (a, s') <- runStateT m s
+ runStateT (f a) s'
+ )
+
+
+
+![]()
+
+
+
+Вернем операции!
+class Monad m => MonadState s m where
+ get :: m s
+ put :: s -> m ()
data StateT s n a = StateT { runStateT :: s -> n (a, s) }
instance Monad n => MonadState s (StateT s n) where
+ get = StateT (\s -> return (s, s))
+ put s = StateT (\_ -> return ((), s)
+
+
+Error
+data ExceptT e n a = ExceptT { runExceptT :: n (Either e a) }
class Monad m => MonadError e m where
+ throwError :: e -> m a
+ catchError :: m a -> (e -> m a) -> m a
instance Monad n => MonadError e (ExceptT e n) where
+ throwError e = ExceptT (return (Left e))
+
+ catchError (ExceptT n) f = ExceptT $ do
+ x <- n
+ case x of
+ Left e -> runExceptT (f e)
+ Right a -> return (Right a)
+
+
+class Monad m => MonadError e m where
+ throwError :: e -> m a
+ catchError :: m a -> (e -> m a) -> m a
data PaymentError = InsufficientBalance
+
+pay :: MonadError e m => Balance -> Price -> m Balance
+pay balance price = do
+ let newBalance = balance - price
+ when (newBalance < 0) (throwError InsufficientBalance)
+ return newBalance
+
+
+The states
+data State s a = State { runState :: s -> (a, s) }
data StateT s m a = StateT { runStateT :: s -> m (a, s) }
🤔
+
+
+
+Напоминалочка:
+data Identity a = Identity { runIdentity :: a }
data State s a = State { runState :: s -> (a, s) }
+
+data StateT s m a = StateT { runStateT :: s -> m (a, s) }
(StateT s Identity a) ~ (s -> Identity (a, s))
🤔
+(s -> Identity (a, s)) ~ (s -> (a, s)) ~ (State s a)
type State s a = StateT s Identity a
+
+
+data ExceptT e n a = ExceptT { runExceptT :: n (Either e a) }
+
+data StateT s m a = StateT { runStateT :: s -> m (a, s) }
+
+class Monad m => MonadError e m where
+ throwError :: e -> m a
+ catchError :: m a -> (e -> m a) -> m a
+
+class Monad m => MonadState s m where
+ get :: m s
+ put :: s -> m ()
Пришли к тому, с чего начинали, только еще сложнее
+
+
+
+
+Отделить эффекты от конкретной монады- Получить возможность комбинировать разные эффекты
+
+
+
+
+foo :: ExceptT Bool (State Char) Int
+foo = do
+ c <- get -- :: State Char Char
+ throwError True -- :: ExceptT Bool (State Char) Int
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
+
+-- Такого нет
+(>=>)
+ :: (Monad m, Monad n)
+ => (a -> m b) -> (b -> n c) -> (a -> ? c)
lift :: State Char a -> ExceptT Bool (State Char) a
foo :: ExceptT Bool (State Char) Int
+foo = do
+ c <- lift get -- :: ExceptT Bool (State Char) Int
+ throwError True -- :: ExceptT Bool (State Char) Int
+
+
+class MonadTrans t where
+ lift :: (Monad m) => m a -> t m a
lift :: State Char a -> ExceptT Bool (State Char) a
+-- (m ) a -> (t ) (m ) a
instance MonadTrans (StateT s) where
+ lift m = StateT $ \ s -> do
+ a <- m
+ return (a, s)
instance MonadTrans (ExceptT e) where
+ lift m = ExceptT (fmap Right m)
foo :: ExceptT Bool (State Char) Int
+foo = do
+ c <- lift get
+ throwError True
+
+
+Но хочется чтобы без lift 🙂
+foo :: ExceptT Bool (State Char) Int
+foo = do
+ c <- get
+ throwError True
Нужен инстанс MonadState для ExceptT
+instance MonadState s n => MonadState s (ExceptT e n) where
+ get = lift get
+ put s = lift (put s)
+
+
+registerPayment
+ :: State TransactionId m
+ => Price -> m Transaction
+pay
+ :: MonadError PaymentError m
+ => Balance -> Price -> m Balance
payAndRegister
+ :: (State TransactionId m, MonadError PaymentError m)
+ => Balance -> Price -> m (Balance, Transaction)
+payAndRegister balance price = do
+ newBalance <- pay balance price
+ transacation <- registerPayment price
+ return (newBalance, transaction)
+
+
+Как это “запускать”?
+payAndRegister
+ :: (State TransactionId m, MonadError PaymentError m)
+ => Balance -> Price -> m (Balance, Transaction)
myBalance :: Balance
+myPrice :: Price
+
+balanceAndTransaction
+ :: Either PaymentError (Balance, Transaction)
data ExceptT e n a = ExceptT { runExceptT :: n (Either e a) }
+data StateT s n a = StateT { runStateT :: s -> n (a, s) }
balanceAndTransaction =
+ runStateT 0 (payAndRegister myBalance myPrice)
+
+
+payAndRegister
+ :: (State TransactionId m, MonadError PaymentError m)
+ => Balance -> Price -> m (Balance, Transaction)
+
+data StateT s n a = StateT { runStateT :: s -> n (a, s) }
balanceAndTransaction
+ :: Either PaymentError (Balance, Transaction)
+balanceAndTransaction =
+ flip runStateT 0 (payAndRegister myBalance myPrice)
flip runStateT 0 (payAndRegister myBalance myPrice)
+-- ^-------------^
+-- StateT TransactionId n a -> n a
-- (n a) ~ (Either PaymentError (Balance, Transaction))
flip runStateT 0 (payAndRegister myBalance myPrice)
+-- ^--------------------------------^
+-- StateT TransactionId
+-- (Either PaymentError)
+-- (Balance, Transaction)
+
+
+payAndRegister
+ :: (State TransactionId m, MonadError PaymentError m)
+ => Balance -> Price -> m (Balance, Transaction)
+
+data ExceptT e n a = ExceptT { runExceptT :: n (Either e a) }
+data StateT s n a = StateT { runStateT :: s -> n (a, s) }
+data Identity a = Identity { runIdentity :: a }
balanceAndTransaction
+ :: Either PaymentError (Balance, Transaction)
+balanceAndTransaction =
+ (runIdentity . runExceptT . flip runStateT 0)
+ (payAndRegister myBalance myPrice)
+
+
+А теперь мы пойдем в совершенно другом направлении!
+
+
+
+Напоминалочка
+class Show a where
+ show :: a -> String
data Foo = Bar { barInt :: Int }
+ deriving Show
show (Bar 8)
+-- Bar {barInt = 8}
+
+
+Read
+Обратная операция к show
+read :: Read a => String -> a
class Read a where
+ readsPrec
+ :: -- | Приоритет контекста выражения
+ Int
+ -> String
+ -> [(a, String)]
data Foo = Bar { barInt :: Int }
+ deriving (Show, Read)
read "Bar {barInt = 8}"
+-- Bar { barInt = 8 }
+
+Монады
+
+- Базовые операции монады (эффекты)
+
+MonadState, MonadErrror
+
+- Конкретные монады (переносчик) (и способы их “разворачивать”)
+
+StateT (runStateT), Either, ExceptT (runExceptT)
+Переводят эффекты в pure код
+
+
+Монада IO
+Обладает только базовыми операциями (Невозможно перевести в pure код)
+getLine :: IO String
+
+putStrLn :: String -> IO ()
type FilePath = String
+
+readFile :: FilePath -> IO String
+
+writeFile :: FilePath -> String -> IO ()
+
+
+add10FromConsole :: IO ()
+add10FromConsole = do
+ x <- getLine
+ let
+ n :: Int
+ n = read x
+ putStrLn (show (n + 10))
+
+
+“Разворачивать” IO умеет только рантайм.
+main :: IO ()
+main = add10FromConsole
> 10
+20
+
+
+
+-- Как 'read', но не взрывается в рантайме
+readMaybe :: Read a => String -> Maybe a
accumulateNums :: StateT Int IO ()
+accumulateNums = do
+ x <- lift getLine
+ case (readMaybe x :: Int) of
+ Nothing -> do
+ s <- get
+ lift (putStrLn (show s))
+ Just x' -> do
+ modify (+ x')
+ accumulateNums
main :: IO ()
+main = flip runStateT 0 accumulateNums
> 8
+> 3
+> a
+11
+
+
+
+accumulateNums :: StateT Int IO ()
-- Хочется так, но где тут взять 'IO'?
+accumulateNums :: MonadState Int m => m ()
Трансформера IO нет.
+Тогда lift!
+Но lift поднимает строго на один уровень.
+
+
+
+class MonadIO m where
+ liftIO :: IO a -> m a
accumulateNums :: (MonadState Int m, MonadIO m) => m ()
+accumulateNums = do
+ x <- liftIO getLine
+ case (readMaybe x :: Int) of
+ Nothing -> do
+ s <- get
+ liftIO (putStrLn (show s))
+ Just x' -> do
+ modify (+ x')
+ accumulateNums
main :: IO ()
+main = flip runStateT 0 accumulateNums
> 8
+> 3
+> a
+11
+
+
