sc-lectures/3.md

theme	author
superblack	Ilya Kostyuchenko

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

---

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

class Functor f where
  fmap :: (a -> b) -> f a -> f b

class Functor f => Alternative f where
  (<|>) :: f a -> f a -> f a
  empty :: f a

---

Библиотека про математику

(на джаве)

static int add(int x, int y) {
  return x + y;
}

["Нам для сертификации надо чтобы каждая функция логировала свой вызов."]{.fragment}

---

Вариант 1

static int add(int x, int y) {
  log += "add";
  return x + y;
}

1. Неявная зависимость
2. Невозможно рефакторить
3. Почему функция для складывания чисел умеет логи?

---

Вариант 2

static Pair<Integer, String> add(int x, int y, string log) {
  return new Pair(x + y, log + "add");
}

1. Неявная зависимость
2. Невозможно рефакторить
3. Неудобно программировать
4. Почему функция для складывания чисел умеет логи?

---

Вариант ООП

static int add(int x, int y, Logger log) {
  Logger.log("add");
  return x + y;
}

1. Неявная зависимость
2. Невозможно рефакторить
3. Неудобно программировать
4. Почему функция для складывания чисел умеет логи?

---

add :: Int -> Int -> (Int, String)
add x y = (x + y, "add " + show x + show y)

[Неудобно программировать]{ .fragment }

add :: Int -> Int -> Int
times :: Int -> Int -> Int

add8AndDouble :: Int -> Int
add8AndDouble = times 2 . add 8

---

add :: Int -> Int -> (Int, String)
times :: Int -> Int -> (Int, String)

add8AndDouble :: Int -> (Int, String)
add8AndDouble x = (y2, log1 <> log2)
  where
    (y1, log1) = add 8 x
    (y2, log2) = times 2 y1

{height=200px .fragment}

add8AndDouble :: Int -> Int
add8AndDouble = times 2 . add 8

---

data WithLog a = WithLog a String

add :: Int -> Int -> WithLog Int
times :: Int -> Int -> WithLog Int

add8AndDouble :: Int -> WithLog Int
add8AndDouble = times 2 `magic` add 8

magic ::
  (Int -> WithLog Int) ->
  (Int -> WithLog Int) ->
  (Int -> WithLog Int)

magic f g x1 = WithLog x3 (log1 <> log2)
  where
    (WithLog x2 log1) = g x1
    (WithLog x3 log2) = f x2

---

magic ::
  (Int -> WithLog Int) ->
  (Int -> WithLog Int) ->
  (Int -> WithLog Int)

(<=<) ::
  (Int -> WithLog Int) ->
  (Int -> WithLog Int) ->
  (Int -> WithLog Int)

add8AndDouble :: Int -> WithLog Int
add8AndDouble = times 2 <=< add 8

---

factor :: Int -> WithLog [Int]

sum :: [Int] -> WithLog Int

sumFactors :: Int -> WithLog [Int]
sumFactors = sum <=< factor -- Doesn't work :(

(<=<) ::
  (Int -> WithLog Int) ->
  (Int -> WithLog Int) ->
  (Int -> WithLog Int)

(<=<) ::
  (b   -> WithLog c  ) ->
  (a   -> WithLog b  ) ->
  (a   -> WithLog c  )

(.) ::
  (b   ->         c  ) ->
  (a   ->         b  ) ->
  (a   ->         c  )

---

getCoffee :: Order -> Maybe Coffee
payForCoffee :: Coffee -> Maybe Payment

buyCoffee :: Order -> Maybe Payment
buyCoffee = payForCoffee <=< getCoffee

getCoffee :: Order -> Either CoffeeError Coffee
payForCoffee :: Coffee -> Either CoffeeError Payment

buyCoffee :: Order -> Either CoffeeError Payment
buyCoffee = payForCoffee <=< getCoffee

(<=<) ::
  Composable m =>
  (b -> m c) ->
  (a -> m b) ->
  (a -> m c)

---

class Applicative m => Monad m where
  (<=<) :: (b -> m c) -> (a -> m b) -> (a -> m c)

instance Monad Maybe where
  (<=<) f g x = case g x of
    Nothing -> Nothing
    Just x2 -> f x2

instance Monad (Either e) where
  (<=<) f g x = case g x of
    Left e -> Left e
    Right x2 -> f x2

instance Monad WithLog where
  (<=<) f g x = WithLog x3 (log1 <> log2)
     where
       (WithLog x2 log1) = g x
       (WithLog x3 log2) = f x2

---

Больше операторов!

(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)

buyCoffee :: Order -> Maybe Payment
buyCoffee = payForCoffee <=< getCoffee

flip :: (a -> b -> c) -> (b -> a -> c)
flip f b a = f a b

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
(>=>) = flip (<=<)

buyCoffee = getCoffee >=> payForCoffee

---

Маленькое отступление

f :: () -> a эквивалентно f :: a

[Потому что у () всего одно значение (()), а любая функция для одинаковых аргументов всегда возвращает одинаковые значения (потому что по-другому невозможно).]{ .fragment }

---

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)

(>>=) :: Monad m => m b -> (b -> m c) -> m c

buyCoffee :: Order -> Maybe Payment
buyCoffee order = getCoffee order >>= payForCoffee

maybeBuyCoffee :: Maybe Order -> Maybe Payment
maybeBuyCoffee mOrder = mOrder >>= buyCoffee

(>>=) :: Monad m =>        m b  -> (b -> m c) ->        m c

(>=>) :: Monad m => (a  -> m b) -> (b -> m c) -> (a  -> m c)

                    (() -> m b) -> (b -> m c) -> (() -> m c)

                           m b  -> (b -> m c) ->        m c

---

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)

(>>=) :: Monad m =>       m b  -> (b -> m c) ->       m c
(>>=) mb bmc = ( (\() -> mb) >=> bmc ) ()

(>>=) mb bmc = ( (\() -> mb) >=> bmc ) ()
--              () -> m b         |
--                             b -> m c
--
--           ^-----------------------^
--                  () -> m c

---

Время раскрыть ложь

class Applicative m => Monad m where
  (>>=) :: m a -> (a -> m b) -> m b
  return :: a -> m a

   -- Law:
  ma :: m a
  (ma >>= return) == ma

   -- Law:
  f :: a -> m b
  (f >=> return) == f

[return -- нейтральный элемент по >=>]{.fragment}

   -- Law:
  x :: a
  f :: a -> m b
  (return x >>= f) == f x

---

instance Monad Maybe where
  ma >>= f = case ma of
    Nothing -> Nothing
    Just a -> f a

  return a = Just a

instance Monad (Either e) where
  ma >>= f = case ma of
    Left e -> Left e
    Right a -> f a

  return a = Right a

instance Monad WithLog where
  (WithLog a log1) >>= f = WithLog b (log1 <> log2)
    where
      WithLog b log2 = f a

  return a = WithLog a ""

---

More Monads!

type Markup = Int

getCoffee :: Markup -> Order -> Coffee
payForCoffee :: Markup -> Coffee -> Payment

buyCoffee :: Markup -> Order -> Payment
buyCoffee markup = payForCoffee markup . getCoffee markup

data Reader r a = Reader
  { runReader :: r -> a
  }

[r -- то, что у нас в "окружении".]{ .fragment }

---

data Reader r a = Reader { runReader :: r -> a }

getCoffee :: Order -> Markup -> Coffee
payForCoffee :: Coffee -> Markup -> Payment

getCoffee :: Order -> Reader Markup Coffee
payForCoffee :: Coffee -> Reader Markup Payment

type PricingEnv = Reader Markup

getCoffee :: Order -> PricingEnv Coffee
payForCoffee :: Coffee -> PricingEnv Payment

buyCoffee :: Order -> PricingEnv Payment
buyCoffee = payForCoffee <=< getCoffee

payment :: Payment
payment = runReader (buyCoffee order) markup

---

data Reader r a = Reader
  { runReader :: r -> a
  }

instance Monad (Reader r) where
  return a = Reader (\_ -> a)

  (Reader g) >>= f = Reader ( \r -> runReader (f (g r)) r )

  (>>=) :: Reader r a -> (a -> Reader r b) -> Reader r b

  (Reader g) >>= f = Reader ( \r -> runReader (f (g r)) r )
--                                               ^---^
--                                                 a
--                                            ^-------^
--                                            Reader r b
--                                  ^-----------------^
--                                         r -> b

---

type Price = Int
getCoffeePrice :: Markup -> Coffee -> Price
getDiscount :: Markup -> Coffee -> Price
getPayment :: Markup -> Price -> Payment

payForCoffee :: Markup -> Coffee -> Payment
payForCoffee markup coffee = getPayment markup amount
  where
    coffeePrice = getCoffeePrice markup coffee
    discount = getDiscount markup coffee
    amount = coffeePrice - discount

type PricingEnv = Reader Markup

getCoffeePrice :: Coffee -> PricingEnv Price
getDiscount :: Coffee -> PricingEnv Price
getPayment :: Price -> PricingEnv Payment

payForCoffee :: Coffee -> PricingEnv Payment
payForCoffee coffee =
  coffee >>= getCoffeePrice >>= \coffeePrice ->
    coffee >>= getDiscount >>= \discount ->
      getPayment (coffeePrice - discount)

---

Do syntax

bar :: Reader r a
qux :: a -> Reader r b

foo :: Reader r b
foo = bar >>= \x -> qux x

foo = do
  -- (x :: a) <- (bar :: Reader r a)
  x <- bar
  qux x

foo = do
  -- (x :: a) <- (bar :: Reader r a)
  x <- bar
  -- (y :: b) <- (qux x :: Reader r b)
  y <- qux x
  return y

foo = bar >>= \x -> qux x >>= return

---

type PricingEnv = Reader Markup

getCoffeePrice :: Coffee -> PricingEnv Price
getDiscount :: Coffee -> PricingEnv Price
getPayment :: Price -> PricingEnv Payment

payForCoffee :: Coffee -> PricingEnv Payment
payForCoffee coffee =
  coffee >>= getCoffeePrice >>= \coffeePrice ->
    coffee >>= getDiscount >>= \discount ->
      getPayment (coffeePrice - discount)

payForCoffee :: Coffee -> PricingEnv Payment
payForCoffee coffee = do
  coffeePrice <- getCoffeePrice coffee
  discount <- getDiscount coffee
  getPayment (coffeePrice - discount)

---

Let statement

payForCoffee :: Coffee -> PricingEnv Payment
payForCoffee coffee = do
  coffeePrice <- getCoffeePrice coffee
  discount <- getDiscount coffee
  getPayment (coffeePrice - discount)

payForCoffee :: Coffee -> PricingEnv Payment
payForCoffee coffee = do
  coffeePrice <- getCoffeePrice coffee
  discount <- getDiscount coffee
  let amount = coffeePrice - discount
  getPayment amount

---

type PricingEnv = Reader Markup
type Price = Int

data Coffee = Coffee { getCoffeePrice :: Price }

getCoffeePrice :: Coffee -> PricingEnv Price

data Reader r a = Reader { runReader :: r -> a}

ask :: Reader r r
ask = Reader (\r -> r)

getCoffeePrice :: Coffee -> PricingEnv Price
getCoffeePrice coffee = do
  -- (markup :: Markup) <- (ask :: PricingEnv Markup)
  markup <- ask
  let coffePrice = getCoffeePrice coffee
  return (coffee + markup)

---

data Order = Order { orderCoffee :: Coffee, orderId :: Int }

createOrder :: Coffee -> Order

[Откуда брать orderId?]{ .fragment }

createOrder :: Coffee -> Reader Int Order
createOrder coffee = do
  newId <- ask
  return (Order coffee newId)

[🎉]{ .fragment }

createOrders :: [Coffee] -> Reader Int [Order]

mapM :: (Monad m) => (a -> m b) -> [a] -> m [b]

createOrders = mapM createOrder

---

createOrders :: [Coffee] -> Reader Int [Order]
createOrders = mapM createOrder

[Все id будут одинаковые.]{ .fragment }

[Reader эквивалентно глобальной константе.]{ .fragment }

[Айдишники -- скорее глобальная переменная.]{ .fragment }

[-- Но у нас же нет переменных!]{ .fragment }

[-- Да, нет!]{ .fragment }

---

State!

data State s a = ... -- s -- само состояние

get :: State s s
put :: s -> State s ()

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

---

data State s a = State { runState :: s -> (a, s) }

class Monad (State s) where
  return x = State (\s -> (x, s))

  (>>=) :: State s a -> (a -> State s b) -> State s b
  (State f) >>= g = State go
    where
      go s = runState (g a) s'
        where
          (a, s') = f s

---

Айдишники!

getNewId :: State Int Int
getNewId = do
  newId <- get
  put (newId + 1)
  return newId

[-- Это какой-то процедурный языке получается!]{ .fragment }

[-- Лучше!*]{ .fragment }

createOrder :: Coffee -> State Int Order
createOrder coffee = do
  newId <- getNewId
  return (Order coffee newId)

createOrders :: [Coffee] -> State Int [Order]
createOrders = mapM createOrder

---

Еще монады!

class Monad [] where
  return x = [x]

  (>>=) :: [a] -> (a -> [b]) -> [b]
  [] >>= _ = []
  (a : aa) >>= f = f a <> (a >>= f)

[Контекст недетерменированности (нескольких вариантов)]{ .fragment }

grid = do
  x <- [1..5]
  y <- [1..5]
  return (x, y)

-- [(1,1),(1,2),(1,3),(1,4),(1,5),(2,1),(2,2),(2,3),(2,4),(2,5),(3,1),(3,2),(3,3),(3,4),(3,5),(4,1),(4,2),(4,3),(4,4),(4,5),(5,1),(5,2),(5,3),(5,4),(5,5)]

---

Тривиальная монада

data Identity a = Identity { runIdentity :: a }

class Monad Identity where
  return x = Identity x

  (>>=) :: Identity a -> (a -> Identity b) -> Identity b
  (Identity a) >>= f = Identity (f a)

---

class Applicative m => Monad m where
  return :: a -> m a
  (>>=) :: m a -> (a -> m b) -> m b

[Монада -- перегрузка композиции функций.]{.fragment }

class Functor m => Applicative m where
  pure :: a -> m a
  (<*>) :: m (a -> b) -> m a -> m b

[Аппликативный функтор -- перегрузка применения функций.]{.fragment }

[-- Почему не (a -> b) -> f a -> f b.]{.fragment }

[-- Это fmap. (И функции нескольких аргументов)]{.fragment }

---

(a -> b) -> f a -> f b

(a -> (b -> c)) -> f a -> f (b -> c)

getMarkup :: Env Markup
getPrice :: Env Price
getPayment :: Markup -> Price -> Payment

payment :: Env Payment
payment = fmap getPayment getMarkup <*> getPrice

payment = fmap getPayment getMarkup <*> getPrice
--        ^-------------^
-- Env Markup -> Env (Price -> Payment)

(<$>) = fmap

payment = getPayment <$> getMarkup <*> getPrice

---

(<*>) :: m (a -> b) -> m a -> m b
mf <*> ma = do
  f <- mf
  a <- ma
  return (f a)

ap :: Monad m => m (a -> b) -> m a -> m b
ap mf ma = do
  f <- mf
  a <- ma
  return (f a)

instance Monad ... where ...

instance Applicative ... where
  pure = return
  (<*>) = ap