17 KiB
theme | author |
---|---|
superblack | Ilya Kostyuchenko |
Функциональное программирование
Напоминалочка
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)
[На каждый чих нужно создавать новый тип?]{.fragment}
Мы хотим:
- Отделить эффекты от конкретной монады
- Получить возможность комбинировать разные эффекты
[(И чтобы не надо было на каждый случай новый тип создавать)]{.fragment}
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" не было привязано к конкретной монаде.
[Мы хотим чтобы "базовые операции" не были привязаны к конкретной монаде.]{.fragment}
-- Было
get :: State s s
put :: s -> State s ()
-- Стало
get :: MonadState s m => m s
put :: MonadState s m => s -> m ()
MonadState
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)
[🎉]{ .fragment }
[(Applicative
тоже можно -- можете сами попробовать)]{ .fragment }
К монадам!
instance (Monad f, Monad g) => Monad (Compose f g) where
return x = Compose (return (return x))
(Compose x) >>= f = ???
[😢]{ .fragment }
[Все равно хочется!]{ .fragment }
data Compose f g a = Compose { getCompose :: f (g a) }
[Для такого не можем]{ .fragment }
data ErrorState e s a =
ErrorState { runErrorState :: State s (Either e a) }
[А для такого можем!]{ .fragment }
(State s (Either e a)) ~ (s -> Either e (a, s))
data ErrorState e s a =
ErrorState { runErrorState :: State s (Either e a) }
[Хочется чтобы можно было не только Either
!]{ .fragment }
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'
)
Transformers!
Вернем операции!
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) }
[🤔]{.fragment}
Напоминалочка:
data Identity a = Identity { runIdentity :: a }
(Identity a) ~ 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))
[🤔]{.fragment}
(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
]{ .fragment }
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
]{ .fragment }
- Конкретные монады (переносчик) (и способы их "разворачивать")
[StateT
(runStateT
), Either
, ExceptT
(runExceptT
)]{ .fragment }
[Переводят эффекты в pure код]{ .fragment }
Монада IO
[Обладает только базовыми операциями]{ .fragment } [(Невозможно перевести в pure код)]{ .fragment }
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
нет.]{ .fragment }
[Тогда lift
!]{ .fragment }
[Но lift
поднимает строго на один уровень.]{ .fragment }
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