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

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

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

“Нам для сертификации надо чтобы каждая функция логировала свой вызов.”

Вариант 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)

Неудобно программировать

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

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

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

(>=>) :: 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 – нейтральный элемент по >=>

   -- 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 – то, что у нас в “окружении”.

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?

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

🎉

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 будут одинаковые.

Reader эквивалентно глобальной константе.

Айдишники – скорее глобальная переменная.

– Но у нас же нет переменных!

– Да, нет!

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

– Это какой-то процедурный языке получается!

– Лучше!*

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)

Контекст недетерменированности (нескольких вариантов)

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

Монада – перегрузка композиции функций.

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

Аппликативный функтор – перегрузка применения функций.

– Почему не (a -> b) -> f a -> f b.

– Это fmap. (И функции нескольких аргументов)

(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