Seminar10.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

module Seminar10 where

import Control.Applicative
import Data.Foldable (toList)
import Data.Monoid

--------------------------------------------------------------------------------
-- МОНАДЫ

-- Монада - это паттерн программирования, который позволяет структурировать
-- вычисления на основе значений и других вычислений, использующих эти значения,
-- чтобы избавить программиста от необходимости вручную обрабатывать результаты
-- каждого вычисления, входящего в состав цепочки вычислений.

-- Таким образом, монады просто позволяют на основе более простых вычислений
-- получать более сложные с дополнительной обработкой результата простых
-- вычислений.

-- Например, если мы хотим реализовать цепочку вычислений, а каждое звено
-- может завершаться с ошибкой, то без монад нам придется после каждого этапа
-- добавлять обработку ошибок. Если это какой-нибудь проброс ошибки дальше, то
-- эта обработка везде одинакова. Монады позволяют устранить эту избыточность.

-- В Haskell центральную роль играет монада ввода-вывода. Так как язык
-- программирования чистый, то это единственный способ взаимодействовать с
-- внешним миром, будь то консоль, файлы, сеть. Конечно, необязательно целиком
-- разбираться в монадах, чтобы с этим работать, но понимание монад позволит
-- вам применять эту концепцию и в других ситуациях.

--------------------------------------------------------------------------------
-- ОПЕРАТОР МОНАДИЧЕСКОГО СВЯЗЫВАНИЯ

-- Результат вычислений в цепочке, которые нужно обрабатывать, может влиять
-- на результат дальнейших вычислений. Это являение называют эффектами при
-- вычислении.

-- Рассмотрим пример, когда такая обработка может потребоваться: поиск
-- прадедушки по папиной линии по маминой линии.
fatherOfFatherOfMother'v1 :: Sheep -> Maybe Sheep
fatherOfFatherOfMother'v1 s =
    case mother s of
        Nothing -> Nothing
        Just m  ->
            case father m of
                Nothing -> Nothing
                Just fm -> father fm

-- Использованные объявления:
data Sheep = Sheep

father :: Sheep -> Maybe Sheep
father = undefined

mother :: Sheep -> Maybe Sheep
mother = undefined

-- Как видно, здесь повторяется обработка вычисления, возвращающего Maybe:
-- если значения нет, то надо прерват всю цепочку вычислений, а если есть,
-- то надо передать это значениев следующее вычисление.

-- Это обработка декомпозируется в оператор монадического связывания, или просто
-- bind. Он уже есть в классе типов Monad, поэтому мы объявим его в виде
-- функции. Что нам понадобится: некоторая монада Maybe и функция, которая
-- передает значение из Maybe в дальнейшее вычисление:
bind :: Maybe a -> (a -> Maybe b) -> Maybe b
bind Nothing  _ = Nothing -- Если значения нет, обрываем цепочку.
bind (Just x) k = k x -- Если есть, передаем его дальше.

-- Таким образом, функция превращается в такой конвейер:
fatherOfFatherOfMother'v2 :: Sheep -> Maybe Sheep
fatherOfFatherOfMother'v2 s = mother s `bind` father `bind` father

-- Кода стало меньше, при этом он стал чище, его проще писать, изменять и
-- понимать.

--------------------------------------------------------------------------------
-- КЛАСС ТИПОВ MONAD

-- В Haskell монада - это расширение понятие аппликативного функтора,
-- для создания монады надо имет всего две вещи:
-- 1. аппликативный функтор;
-- 2. оператор монадического связывания.

-- Определение класса типов Monad:

{-
class Applicative m => Monad m where
    return :: a -> m a
    return = pure

    (>>=) :: m a -> (a -> m b) -> m b
    infixl 1 >>=

    (>>) :: m a -> m b -> m b
    ma >> mb = ma >>= (const mb)
    infixl 1 >>
-}

-- return тривиально оборачивает произвольное значение в монаду, (>>=) - это тот
-- самый оператор монадического связывания, а (>>) - это (>>=) с отбрасыванием
-- значения (но не эффекта при вычислении этого отбрасываемого значения!).

-- Как видно, минимальная полная реализация монады состоит только из
-- (>>=).

-- Обратите внимание, что bind работает с двумя монадами, но они должна быть
-- одного типа, то есть производить одинаковые эффекты. Значения при этом могут
-- иметь разные типы.

-- Кроме того, есть оператор bind с переставленными местами аргументами:
(=<<) :: Monad m => (a -> m b) -> m a -> m b -- Control.Monad.
(=<<) = flip (>>=)
infixr 1 =<<

-- Вообще говоря, впрочем, как и всегда, необязательно делать свой тип
-- экземпляром класса типов Monad, чтобы с ним работать. Но если раньше
-- мы выигрывали только доступ к каким-то функциям, требующим класс типов
-- в контексте, то в случае монад есть намного более серьезное преимущество:
-- do-нотация. Ее мы разберем ниже, но суть в том, что это синтаксический сахар
-- для записи монадических вычислений, соответственно, типы должны реализовывать
-- интерфейс монады:
fatherOfFatherOfMother'v3 :: Sheep -> Maybe Sheep
fatherOfFatherOfMother'v3 s = do
    m <- mother s -- (x :: a) <- (mx :: m a)
    fm <- father m
    ffm <- father fm
    return ffm

-- Все пять известных нам аппликативных функторов можно расширить до монады:
-- Maybe, список, Either, пара и функция.

--------------------------------------------------------------------------------
-- СТРЕЛКА КЛЕЙСЛИ

-- Функции с типом a -> m b, где m - это монада, называют стрелками Клейсли.
-- Это название мы будем часто использовать в дальнейшем. Пример стрелки
-- Клейсли - это только изученная функция return. Более того, return
-- позволяет любую функцию превратить в тривиальную стрелку клейсли:
makeKleisli :: Monad m => (a -> b) -> (a -> m b)
makeKleisli f = return . f

--------------------------------------------------------------------------------
-- ONE-WAY МОНАДЫ

-- Обратите внимание на замечательный факт: в интерфейсе не представлено никакой
-- функции, с помощью которой можно было бы составить функцию типа m a -> b, то
-- есть нечто обратное стрелки Клейсли. Таким образом, в общем случае если
-- значение обернуто в монаду, достать его из монады может быть невозможно.

-- Для некоторых монад это возможно: например, монада пары. Но в обзем случае
-- можно только передавать его в цепочку монадических вычислений. Как мы знаем,
-- в такой цепочки тип монады не меняется, то есть значение остается там
-- навсегда. Пример такой монады - это монада ввода-вывода, которую мы упоминали
-- выше.

-- Такие монады называются one-way монадами. Их особенность в том, что они
-- могут инкапуслировать в себе побочные эффекты в рамках вычислений, при этом
-- не нарушая чистоты остальной части программы. Именно поэтому Haskell
-- принято считать чистым функциональным языком программирования.

-- Рассмотрим пример: функция readChar :: Char, которая читает с экрана,
-- нарушает чистоту языка, поскольку в общем случае возвращает разные значения
-- при каждом вызове. Но функция getChat :: IO Char читает с экрана и
-- и возвращает IO-монаду. Разумеется, само значение в монаде разное, но так
-- как это one-way монада, узнать мы об этом можем только оставаясь в рамках
-- этой монады.

--------------------------------------------------------------------------------
-- ЗАКОНЫ ДЛЯ МОНАД

-- Сама концепция монады происходит из теории категорий, где она определяется
-- как моноид в моноидальной категории эндофункторов, чтобы это ни значило.
-- Отсюда важно лишь почерпнуть, что монада - это в некотором смысле моноид,
-- а это объясняет вид законов для монад:

-- 1. return x >>= k      =  k x
-- 2. mx >>= return       =  mx
-- 3. (mx >>= k1) >>= k2  =  mx >>= (\ x -> k1 x >>= k2)

-- Действительно, здесь return - примерно нейтральный элемент (слева и справа
-- он отбрасывается), а монадическое связывание немножко ассоциативно.

--------------------------------------------------------------------------------
-- КЛАСС ТИПОВ MONADPLUS

-- MonadPlus - это расширяение классов типов Monad. Он полезен, когда нужно
-- скомбинировать несколько отдельных монадических вычислений в одно.

-- Такие монады имеют бинарную ассоциативную операцию mplus нейтральный по ней
-- элемент mzero.

-- Так как монады являются аппликативными функторами, то нельзя
-- не вспомнить о классе типов Alternative, который представлял моноид на
-- аппликативных фукторах. Оказывается, MonadPlus расширяет и Alternative тоже.
-- Более того, операция и нейтральный элемент имеют из него реализацию по
-- умолчанию.

class (Alternative m, Monad m) => MonadPlus m where
    mzero :: m a
    mzero = empty

    mplus :: m a -> m a -> m a
    mplus = (<|>)

-- Соотвестственно, реализация этого интерфейса почти бесплатна: надо просто
-- написать одну строчку.

--------------------------------------------------------------------------------
-- ЗАКОНЫ ДЛЯ MONADPLUS

-- Законы для MonadPlus гарантируют, что mzero нейтральный элемент.

-- 1. mzero >>= k = mzero
-- 2. mx >>= (\ _ -> mzero) = mzero
-- 3. mzero `mplus` mx = mx
-- 4. mx `mplus` mzero = mx

-- Как видно, можно ассоциировать mzero с нулем, mplus со сложением, а (>>=) - с
-- умножением: 0 * k = 0, x * 0 = 0, 0 + x = x, x + 0 = x.

--------------------------------------------------------------------------------
-- МОНАДА IDENTITY

newtype Identity a = Identity { runIdentity :: a } deriving Show

-- Монада Identity - это монада для вычислений без эффектов, то есть при
-- монадическом связывании никакой обработки не происходит. Без учета обертки
-- return вырождается в id, а x >>= f - в f x.

-- Объявлять монадический тип с меткой run, как мы сделали выше, - это общий
-- стиль задания монадических типов. Так как монады на самом деле инкапсулируют
-- вычисления, то значения достаются запуском этих вычислений.

-- Для начала вспомним, что монада расширяет понятие аппликативного функтора,
-- а аппликативный функтор расширяет понятие обычного функтора. Значит, нужно
-- объявить целых три экземпляра.

instance Functor Identity where
    fmap :: (a -> b) -> Identity a -> Identity b
    fmap f (Identity x) = Identity $ f x

instance Applicative Identity where
    pure :: a -> Identity a
    pure = Identity

    (<*>) :: Identity (a -> b) -> Identity a -> Identity b
    Identity f <*> Identity x = Identity $ f x

instance Monad Identity where
    (>>=) :: Identity a -> (a -> Identity b) -> Identity b
    Identity x >>= k = k x

-- На самом деле монада Identity нужна не только как пример самой тривиальной
-- монады. Ее содержательное применение мы рассмотрим в следующий раз, когда
-- будем изучать монадические трансформеры. Типичный пример использования
-- выглядит так:
--type State s a = StateT s Identity a -- Что бы это ни значило.

--------------------------------------------------------------------------------
-- МОНАДА MAYBE

-- Монада Maybe организует вычисления, которые могут не возвращать результат.
-- Ее мы уже разбирали ранее.

-- Maybe уже есть в языка как монада, поэтому для демонстрации необходимо
-- продублировать тип. В комментарии мы будем указывать реализацию для
-- библиотечной Maybe.
data Maybe' a = Nothing' | Just' a deriving Show

instance Functor Maybe' where
    fmap :: (a -> b) -> Maybe' a -> Maybe' b
    fmap f (Just' x) = Just' $ f x
    fmap _ Nothing'  = Nothing'
    -- fmap f = maybe Nothing (Just . f)

instance Applicative Maybe' where
    pure :: a -> Maybe' a
    pure = Just'
    -- pure = Just

    (<*>) :: Maybe' (a -> b) -> Maybe' a -> Maybe' b
    Just' f <*> Just' x = Just' $ f x
    _       <*> _       = Nothing'
    -- mf <*> mx = maybe Nothing (\ f -> fmap f mx) mf

instance Monad Maybe' where
    (>>=) :: Maybe' a -> (a -> Maybe' b) -> Maybe' b
    Just' x >>= k = k x
    _       >>= _ = Nothing'
    -- mx >>= k maybe Nothing k mx

-- Maybe также является и MonadPlus:
instance MonadPlus Maybe

-- Монада Maybe полезна, когда есть цепочка вычислений, каждое из которых
-- использует результат предудщего, но может не вернуть результат. В качестве
-- жизненных примеров - это сложные запросы к базам данных или поиска в
-- словарях.

--------------------------------------------------------------------------------
-- DO-НОТАЦИЯ

-- Теперь, когда мы реализовали первую содержательную монаду, можно изучть
-- do-нотацию - специальный синтаксический сахар, монадический синтаксис для
-- записи вычислений. Рассмотрим ее на простом примере, где нужно получить корни
-- уравнения вида x^2 + x - c. Они равны (-1 +- sqrt(1 + 4c)) / 2, если
-- определены.

-- Запишем сначала вычисления без этого синтаксиса. Как бы мы это сделали:
findRoots' :: Double -> Maybe (Double, Double)
findRoots' c =
    findSqrt (1 + 4 * c) >>= \ rd -> let
            x1 = (-1 + rd) / 2
            x2 = (-1 - rd) / 2
        in return (x1, x2)

-- Здесь процедура достаточно простая, но уже тут видно, что для связываний
-- нужно писать лямбда-выражении. Третий закон монад, расставляющий скобки
-- в другую сторону, не всегда помогает этого избежать, потому что часто
-- значение нужно передать в несколько последующийх вычислений, а не только
-- в непосредственно следующее. Лямбды позволяют сделать область видимости
-- более гибкой.

-- Этим мотивируется введение do-нотации. Примерные правила трансляции
-- следующие:
-- do { mx ; my } = mx >> my -- отбрасываем значение первой монады.
-- do { p <- mx; my } = mx >>= \ p -> my -- Здесь p - это образец. Об этом ниже.
-- do { let v = e; m } = let v = e in do m

-- С ее использованием поиск переписывается в виде:
findRoots :: Double -> Maybe (Double, Double)
findRoots c = do
    rd <- findSqrt (1 + 4 * c)
    let x1 = (-1 + rd) / 2
    let x2 = (-1 - rd) / 2
    return (x1, x2)

findSqrt :: Double -> Maybe Double
findSqrt x | x >= 0    = Just $ sqrt x
           | otherwise = Nothing

--------------------------------------------------------------------------------
-- МОНАДА EITHER

-- Either организует вычисления, которые могут завершаться с типизированной
-- ошибкой.

-- Either тоже уже есть в языке, поэтому проделаем тот же трюк.
data Either' a b = Left' a | Right' b deriving Show

instance Functor (Either' e) where
    fmap :: (a -> b) -> Either' e a -> Either' e b
    fmap _ (Left' e)  = Left' e
    fmap f (Right' x) = Right' $ f x
    -- fmap f = either Left (Right . f)

instance Applicative (Either' e) where
    pure :: a -> Either' e a
    pure = Right'
    -- pure = Right

    (<*>) :: Either' e (a -> b) -> Either' e a -> Either' e b
    Right' f <*> Right' x = Right' $ f x
    Left' e  <*> _        = Left' e
    _        <*> Left' e  = Left' e
    -- ef <*> ex = either Left (\ f -> fmap f ex) ef

instance Monad (Either' e) where
    (>>=) :: Either' e a -> (a -> Either' e b) -> Either' e b
    Left' e  >>= _ = Left' e
    Right' x >>= k = k x
    -- ef >>= k = either Left k ef

--------------------------------------------------------------------------------
-- ПРИМЕР ИСПОЛЬЗОВАНИЕ EITHER

-- С помощью монады Either можно переписать поиск корней в получение корней, -
-- который возвращает ошибку, если их не оказалось.
getRoots :: Double -> Either String (Double, Double)
getRoots c = do
    rd <- getSqrt (1 + 4 * c)
    let x1 = (-1 + rd) / 2
    let x2 = (-1 - rd) / 2
    return (x1, x2)

getSqrt :: Double -> Either String Double
getSqrt x | x >= 0    = Right $ sqrt x
          | otherwise = Left "`getSqrt x` requires `x >= 0`"

--------------------------------------------------------------------------------
-- МОНАДА СПИСКА

-- Список, как мы можем догадаться из определения аппликативного функтора, -
-- это монада нетедетерминированных вычислений, то есть вычислений, которые
-- возвращают 0, 1 или более результатов за раз. В этом случае монадическое
-- связывание заключается в переборе всех возможных значений аргумента и
-- агрегации всех результатов.

-- Список тоже придется перереализовать:
data List a = Nil | a :+ List a deriving Show
infixr 5 :+

-- Чтобы писать list comprehension, нужно использовать списки. У нас есть
-- функция toList, которую можно достать из класса типов Foldable:
instance Foldable List where
    foldr :: (a -> b -> b) -> b -> List a -> b
    foldr _ y Nil       = y
    foldr f y (x :+ xs) = f x (foldr f y xs)

-- Обратное преобразование:
toList' :: [a] -> List a
toList' = foldr (:+) Nil

instance Functor List where
    fmap :: (a -> b) -> List a -> List b
    fmap _ Nil       = Nil
    fmap f (x :+ xs) = f x :+ fmap f xs
    -- fmap = map

instance Applicative List where
    pure :: a -> List a
    pure x = x :+ Nil
    -- pure x = [x]

    (<*>) :: List (a -> b) -> List a -> List b
    fs <*> xs = toList' [f x | f <- toList fs, x <- toList xs]
    -- fs <*> xs = [f x | f <- fs, x <- xs]

instance Monad List where
    (>>=) :: List a -> (a -> List b) -> List b
    xs >>= k = toList' $ concat [toList $ k x | x <- toList xs]
    -- xs >>= k = concatMap k xs

-- Список также является и MonadPlus:
instance MonadPlus []

--------------------------------------------------------------------------------
-- ПРИМЕР ИСПОЛЬЗОВАНИЯ МОНАДЫ СПИСКА

-- Как обычно, применим нашу монаду к поиску корней квадратного уравнения:
listRoots :: Double -> [Double]
listRoots c = do
    rd <- solveX2 (1 + 4 * c)
    let x = (-1 + rd) / 2
    return x

-- Функция для перечисления корней уравнения x^2 = c.
solveX2 :: Double -> [Double]
solveX2 0 = [0]
solveX2 x | x > 0     = let r = sqrt x in [r, -r]
          | otherwise = []

--------------------------------------------------------------------------------
-- ФУНКЦИИ ДЛЯ РАБОТЫ С МОНАДАМИ

-- Давайте познакомимся с некоторыми функциями для работы с монадами. Для
-- начала вспомним про класс типов Traversable, который представляет собой
-- контейнер, по которому можно итерироваться, собирая аппликативные эффекты.

-- Монады, являясь аппликативными функторами, также могут быть элементами
-- traversable-контейнеров, значит, к ним применимы как функция sequenceA,
-- так и traverse, а также их версии с отбрасываением значения: sequenceA_ и
-- traverse_.

-- Но оказывается, в классе типов Traversable по историческим причинам объявлены
-- еще две функции:

--mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m b
--mapM = traverse

--sequence :: (Traversable t, Monad m) => t (m a) -> m (t a)
--sequence = sequenceA

-- Дело в том, что раньше монады и аппликативные функторы были не связанными
-- классами типов, поэтому присутствуют версии для обоих классов типов. Но зато
-- если вдруг для монады можно реализовать более эффективный traverse или
-- sequence, то это можно сделать явно.

-- Также есть версии для монад, но с отбрасыванием значений:
-- * sequence_ ::  (Traversable t, Monad m) => t (m a) -> m ()
-- * mapM_ :: (Traversable t, Monad m) => (a -> m b) -> t a -> m ()

-- Кроме того, в модуле Control.Monad есть и другие полезные функции:
-- * forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
-- * forM_ :: (Traversable t, Monad m) => t a -> (a -> m b) -> m ()
-- * (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
-- * (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)

-- Функции для работы со списками монад:
-- * foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
-- * foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()
-- * replicateM :: Applicative m => Int -> m a -> m [a]
-- * replicateM_ :: Applicative m => Int -> m a -> m ()

-- Наконец, блок функций для подъема вычислений в монады:
-- * liftM :: Monad m => (a -> b) -> m a -> m b
-- * а также liftM2, liftM3, liftM4, liftM5
-- * ap :: Monad m => m (a -> b) -> m a -> m b

--------------------------------------------------------------------------------
-- МОНАДА STATE

-- В чистых функциональных языках нельзя обновлять значения, потому то это
-- нарушет ссылочную прозрачность. Но можно создать иллюзию, если передавать
-- значение из одного вычисления в следующее. Тогда при этой передаче его можно
-- изменять. Так можно, например, реализовать генератор псевдослучайных чисел.

-- State - это монада, которая позволяет поддерживать общее состояние для
-- последовательности вычислений. Оно использует именно эту идею.

newtype State s a = State { runState :: s -> (a, s) }
-- Здесь аргумент функции - это текущее состояние, а результат - это значение
-- и новое сосотояние. Разумеется, у состояния должен быть тот же тип.

-- Реализуем теперь экземпляры функтора, аппликативного функтора и монады для
-- объявленного типа.

instance Functor (State s) where
    fmap :: (a -> b) -> State s a -> State s b
    fmap f mx = State $ \ s -> let
            (x, s') = runState mx s
        in (f x, s')

instance Applicative (State s) where
    pure :: a -> State s a
    pure x = State $ \ s -> (x, s)

    (<*>) :: State s (a -> b) -> State s a -> State s b
    mf <*> mx = State $ \ s -> let
            (f, s') = runState mf s
            (x, s'') = runState mx s'
        in (f x, s'')

instance Monad (State s) where
    (>>=) :: State s a -> (a -> State s b) -> State s b
    mx >>= k = State $ \ s -> let
            (x, s') = runState mx s
            (y, s'') = runState (k x) s'
        in (y, s'')

-- return, или pure, устанавливает значение, но оставляет результат неизменным,
-- а bind меняет состояние и отдает его в следующее результат.

--------------------------------------------------------------------------------
-- ФУНКЦИИ ДЛЯ РАБОТЫ С СОСТОЯНИМИ

-- Для удобства работы с состоянием можно выделить три функции, которые
-- меняет или получают состояние.

get :: State s s
get = State $ \ s -> (s, s)

-- В put нет возвращаемого результата, поэтому используется пустой кортеж.
put :: s -> State s ()
put s = State $ \ _ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \ s -> ((), f s)

-- Можно включить расширения языка и объядинить три функции в класс типов
-- MonadState.

-- Кроме того, для стейта будут полезны еще две функции: достать состояние и
-- достать значение.
evalState :: State s a -> s -> s
evalState mx = snd . runState mx

execState :: State s a -> s -> a
execState mx = fst . runState mx

--------------------------------------------------------------------------------
-- ПРИМЕР ИСПОЛЬЗОВАНИЕ STATE

-- С помощью State можно реализовать, например, вычисление чисел Фибоначчи, как
-- мы делали это в императивном языке: с помощью двух переменных.
fibStep :: State (Integer, Integer) ()
fibStep = do
  (p, c) <- get
  put (c, p + c)

fib n = snd $ evalState (sequence_ $ replicate n fibStep) (0, 1)

--------------------------------------------------------------------------------
-- МОНАДА READER

-- Монада Reader позволяет выразить процесс вычислений, которые в процессе
-- могут обращаться к некоторому общему для всех состоянию.

newtype Reader e a = Reader { runReader :: e -> a }

instance Functor (Reader e) where
    fmap :: (a -> b) -> Reader e a -> Reader e b
    fmap f mx = Reader $ \ e -> let
            x = runReader mx e
        in f x

instance Applicative (Reader e) where
    pure :: a -> Reader e a
    pure x = Reader $ \ _ -> x

    (<*>) :: Reader e (a -> b) -> Reader e a -> Reader e b
    mf <*> mx = Reader $ \ e -> let
            f = runReader mf e
            x = runReader mx e
        in f x

instance Monad (Reader e) where
    (>>=) :: Reader e a -> (a -> Reader e b) -> Reader e b
    mx >>= k = Reader $ \ e -> let
            x = runReader mx e
            y = runReader (k x) e
        in y

--------------------------------------------------------------------------------
-- ПРЕОБРАЗОВАНИЕ STATE К READER

-- Reader является частным случаем монады State. Действительно, если Reader
-- представим как State, в котором состояние не меняется. Более того, можно
-- в явном виде написать преобразование:
reader2state :: Reader s a -> State s a
reader2state rx = State $ \ s -> (runReader rx s, s)

-- Поэтому, конечно, вместо монады Reader всегда можно использовать State, но
-- обычно код получается чуть чище, потому что проще устроен монадический тип.

--------------------------------------------------------------------------------
-- ФУНКЦИИ ДЛЯ РАБОТЫ С ОКРУЖЕНИЕМ

-- Функция ask позволяет внутри монадического вычисления запросить текущее
-- окружение.
ask :: Reader e e
ask = Reader id

-- Иногда нужно получить не вcе окружение, а его часть, тогда можно
-- воспользоваться функцией asks. Это полезно, если все окружение достаточно
-- громоздко, а работать надо с малой его частью, причем весьма часто.
asks :: (e -> a) -> Reader e a
asks = Reader

-- local позволяет выполнить вычисление в локально модифицированном окружении
-- того же типа. Если бы тип был другой, то цепочки нельзя было бы монадически
-- связывать.
local :: (e -> e) -> Reader e a -> Reader e a
local f r = Reader $ \ e -> runReader r (f e)

--------------------------------------------------------------------------------
-- ПРИМЕР ИСПОЛЬЗОВАНИЯ READER

-- Вернуть список пользователей, использующих такой-то пароль.

type User = String
type Password = String
type UsersTable = [(User, Password)]

usersByPassword :: Password -> Reader UsersTable [User]
usersByPassword p = asks $ map fst . (filter $ (== p) . snd)

--------------------------------------------------------------------------------
-- МОНАДА WRITER

-- В монаде Writer выполняются вычисления, которые помимо получения значения,
-- производят также порции дополнительной информации, которая агрегируется
-- на каждом шаге.

-- Типичный пример использования - логирование.

newtype Writer w a = Writer { runWriter :: (a, w) }

instance Functor (Writer w) where
    fmap :: (a -> b) -> Writer w a -> Writer w b
    fmap f wx = Writer $ let
            (x, w) = runWriter wx
        in (f x, w)

instance Monoid w => Applicative (Writer w) where
    pure :: a -> Writer w a
    pure x = Writer (x, mempty)

    (<*>) :: Writer w (a -> b) -> Writer w a -> Writer w b
    wf <*> wx = Writer $ let
            (f, w1) = runWriter wf
            (x, w2) = runWriter wx
        in (f x, w1 <> w2)

instance Monoid w => Monad (Writer w) where
    (>>=) :: Writer w a -> (a -> Writer w b) -> Writer w b
    wx >>= k = Writer $ let
            (x, w1) = runWriter wx
            (y, w2) = runWriter (k x)
        in (y, w1 <> w2)

--------------------------------------------------------------------------------
-- ПРЕОБРАЗОВАНИЕ WRITER К STATE

-- Как и Reader, Writer является частным случаем монады State, когда состояние
-- никто не читает. Можно записать преобразование одной монады к другой более
-- формально:
writer2state :: Monoid w => Writer w a -> State w a
writer2state wx = State $ \ s -> let
        (x, w) = runWriter wx
    in (x, s <> w)

--------------------------------------------------------------------------------
-- ФУНКЦИИ ДЛЯ РАБОТЫ С ЛОГОМ

-- Чтобы записать значение в лог, можно использовать функцию tell:
tell :: Monoid w => w -> Writer w ()
tell w = Writer ((), w)

-- Кроме того, как и в случае со State, будут полезны еще две функции: достать
-- лог и достать значение.
evalWriter :: Writer w a -> a
evalWriter = fst . runWriter

execWriter :: Writer w a -> w
execWriter = snd . runWriter

--------------------------------------------------------------------------------
-- ПРИМЕР ИСПОЛЬЗОВАНИЯ WRITER

-- Логом необязательно будет именно лог в прямом смысле. Иногда его можно
-- использовать и для агрегации каких-либо значений, если в моноидном типе
-- хорошо выбрана операция.

-- Рассмотрим пример: кассовый аппарат для магазина. Описание купленных
-- товаров пишется в do-нотации следующим образом:

type Shopping = Writer ([String], Sum Integer) ()

shopping :: Shopping
shopping = do
    purchase "Jeans" 19200
    purchase "Water" 180
    purchase "Apple" 328

-- total shopping = 19708
-- items shopping = ["Jeans", "Water", "Apple"]

-- Тогда мы можем получать как список покупок, так и общую сумму вырученных
-- денег:
purchase :: String -> Integer -> Shopping
purchase item cost = tell ([item], Sum cost)

total :: Shopping -> Integer
total = getSum . snd . execWriter

items :: Shopping -> [String]
items = fst . execWriter

------------------------------------------------------------------------------
-- МОНАДА IO

-- Наконец, последняя монада, с которой нам нужно познакомится, это монада
-- ввода-вывода.

-- Определение этой монады зависит от платформы, и для нее нет никаких
-- конструкторов данных или работы с ними. Но по смыслу IO близок к монаде
-- State, только состояние - это некоторый внешний мир.

-- В Haskell функция main должны иметь тип IO (). Она является точкой входа
-- в наше приложение; таким образом, запуск программы, это какое-то действие,
-- которое в итоге не вернет никакого результата, но будет в процессе работать
-- с внешним миром: читать с консоли, писать в нее и так далее.

-- Сами функции, которые есть в модуле IO или Prelude, не выполняют никаких
-- действий ввода-вывода. Они возвращают IO, которые уже в свою очередь
-- общаются с окружением.

-- Прочитать 1 символ.
-- getChar :: IO Char

-- Записать 1 символ. Можно использовать putChar '\n' для перевода строки.
-- putChar :: Char -> IO ()

-- Записать строку без перевода строки.
-- putStr :: String -> IO ()

-- Записать строку с переводом строки.
-- putStrLn :: String -> IO ()
-- putStrLn s = putStr s >> putChar '\n'

-- Прочитать 1 строку до перевода строки.
-- getLine :: IO String

-- Записать произвольный объект, который можно привести к строке.
-- print :: Show a => a -> IO ()

-- Считать все содержимое.
-- getContents :: IO String

-- Прочитать все содержимое, применить к нему функцию и вывести результат.
-- interact :: (String -> String) -> IO ()
-- interact f = getContents >>= makeKleisli f >>= putStr

-- Функции для работы с файлами:
-- * readFile :: FilePath -> IO String
-- * writeFile :: FilePath -> String -> IO ()
-- * appendFile :: FilePath -> String -> IO ()
-- FilePath - алиас на String.

--------------------------------------------------------------------------------
-- СОПОСТАВЛЕНИЕ С ОБРАЗЦОМ В DO-НОТАЦИИ

-- При изучении правил do-нотации можно было заметить, что когда мы извлекаем
-- значение из монады, можно не связывать его с простым именем, а использовать
-- полноценное сопоставление с образцом:
pifs'v1 :: [(Int, Int, Int)]
pifs'v1 = do
    x <- [ 1 .. 10 ]
    y <- [ 1 .. 10 ]
    z <- [ 1 .. 10 ]
    True <- return (x <= y)
    True <- return (x ^ 2 + y ^ 2 == z ^ 2)
    return (x, y, z)

-- Что происходит, если сопоставление с образцом неудачно? Оказывается, в таком
-- случае вызывается функция fail из класса типов MonadFail.

-- А если монада не реализует MonadFail, то код с использованием образцов,
-- сопоставление с которыми может быть неудачно, не компилируется.

--------------------------------------------------------------------------------
-- КЛАСС ТИПОВ MONADFAIL

--class Monad m => MonadFail m where
--    fail :: String -> m a

-- Смысл функции fail в том, что мы можем восстановиться от произошедшей ошибки
-- (ее текст передается в аргумент) и продолжить вычисление. Саму ошибку в этом
-- случае можно игнорировать.

-- Для класса типов должен быть выполнен всего один закон: fail должен быть
-- левым поглощающим элементом для монадического связывания:
-- * fail s >>= mx = fail s

--------------------------------------------------------------------------------
-- ЭКЗЕМПЛЯРЫ MONADFAIL

-- Для списков неудачное сопоставление с образцом означает, что все ветку
-- множественных вычислений нужно загасить. Для этого достаточно вернуть
-- пустой список, так как длины перемножаются.
instance MonadFail List where
    fail :: String -> List a
    fail = const Nil

-- Для Maybe, разумеется, просто прерывание вычисления.
instance MonadFail Maybe' where
    fail :: String -> Maybe' a
    fail = const Nothing'

-- Таким образом, сопоставление с образцом доступно только в монадах списка и
-- Maybe.  Также есть реализация для IO, она выводит строку на консоль.

-- Можно реализовать MonadFail для Either String, чтобы выдавать сообщение
-- ошибки в Left. Потребуется расширение FlexibleInstances, так как по
-- умолчанию требуется, чтобы типы имели вид T x1 ... xN, где x1, ..., xN -
-- разные переменные типов.
instance MonadFail (Either String) where
    fail :: String -> Either String a
    fail = Left

--------------------------------------------------------------------------------
-- ФУНКЦИЯ GUARD

-- Мы видели, как можно использовать фильтрацию с использованием сопоставления с
-- True результата оборачивания в return логического выражения. Но это выглядит
-- немного громоздко, поэтому есть функция guard. Но опрередела не для монад, а
-- для Alternative, и имеет тот же эффект. Даже без MonadFail.

guard :: Alternative f => Bool -> f ()
guard True  = pure ()
guard False = empty

pifs'v2 :: [(Int, Int, Int)]
pifs'v2 = do
    x <- [ 1 .. 10 ]
    y <- [ 1 .. 10 ]
    z <- [ 1 .. 10 ]
    guard $ x <= y && x ^ 2 + y ^2 == z ^ 2
    return (x, y, z)

-- Поэтому MonadFail лучше оставить для деструктуризации каких-то значений, а
-- не устнановки гардов.

-- Кроме guard, есть еще функции when и unless:
when :: Applicative f => Bool -> f () -> f ()
when p s = if p then s else pure ()

unless :: Applicative f => Bool -> f () -> f ()
unless p s = if p then pure () else s