Функциональное программирование

Напоминалочка

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 ()

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)

🎉

(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'
    )

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) }

🤔

Напоминалочка:

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))

🤔

(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

Функциональное программирование

Напоминалочка

Either

State

MonadState

MonadError

Transformers!

Вернем операции!

Error

The states

Напоминалочка

Read

Монады

Монада IO

Монада `IO`