Некоторые стандартные монады

Монады как паттерн композиции

Для функций определена композиция (.):

(.) :: (b -> c) -> (a -> b) -> (a -> c)
(f . g) x = f (g x)

В Data.Function есть оператор

(&) :: a -> (a -> b) -> b
x & f = f x

используемый как

1 & (+1) & show & replicate 2 & concat
-- == (concat . replicate 2 . show . (+1)) 1
-- == concat (replicate 2 (show ((+1) 1)))
-- == "22"

Не работает для функций:

realSqrt :: Double -> Maybe Double
realSqrt x | x >= 0 = Just (sqrt x)
           | otherwise = Nothing

realArcsin :: Double -> Maybe Double
realArcsin x | abs x <= 1 = Just (asin x)
             | otherwise = Nothing

композиция вида realArcsin . realSqrt невозможна.

Кажется, должна быть возможна: если realSqrt возвращает Nothing, то результат композиции – Nothing.

Такая композиция (обозначим её <=<) будет иметь тип

(<=<) :: (b -> Maybe c) -> (a -> Maybe b) -> (a -> Maybe c)
-- для сравнения, тип обычной композиции:
(.) :: (b -> c) -> (a -> b) -> (a -> c)

Введём также аналог оператора &, обозначим его >>=:

(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
-- для сравнения
(&) :: a -> (a -> b) -> b

Абстрагируем. Обобщим сигнатуры до

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

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

Поэтому – класс типов Monad:

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

Заметим, что <=< реализуется в терминах >>=:

(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
(f <=< g) = \x -> g x >>= f

Практически Monad кодирует композицию функций, возвращающих значения в какой-то дополнительной обобщённой структуре.

<=< и симметричный >=> с обратным порядком аргументов – композиция Клейсли.

Функции вида a -> m b – стрелки Клейсли.

Некоторые стандартные монады

`Maybe`

data Maybe a = Nothing | Just a

Минимальное определение:

instance  Functor Maybe  where
    fmap _ Nothing       = Nothing
    fmap f (Just a)      = Just (f a)

instance Applicative Maybe where
    pure = Just

    Just f  <*> m       = fmap f m
    Nothing <*> _m      = Nothing

instance  Monad Maybe  where
    (Just x) >>= k      = k x
    Nothing  >>= _      = Nothing

Практически, монада Maybe удобна для последовательностей “возможно неудачных вычислений” (в широком смысле)

Пример – поиск значения в какой-то базе данных:

itemsTable :: [(ItemId, ItemName)]
categoriesTable :: [(CatId, CategoryName)]
linkingTable :: [(ItemId, CatId)]

getCategoryForItem :: ItemName -> Maybe CategoryName
getCategoryForItem searchName = do
  itemId <- fst
    <$> find (\(key, value) -> value == searchName) itemsTable
  categoryId <- lookup itemId linkingTable
  lookup categoryId categoriesTable

здесь в роли “базы данных” – списки. На практике, например, файл на диске или сервер SQL.

Рассмотрим getCategoryForItem. Перепишем do-нотацию через >>=:

getCategoryForItem searchName =
  fst <$> -- (2)
    find (\(key, value) -> value == searchName) itemsTable -- (1)
  >>= \itemId -> -- (3)
    lookup itemId linkingTable -- (4)
  >>= \categoryId -> -- (5)
    lookup categoryId categoriesTable -- (6)

Находит первый элемент в itemsTable, такой, что второй элемент кортежа равен searchName.

Если найдено, результат – Just (key, value)

Иначе Nothing.

getCategoryForItem searchName =
  fst <$> -- (2)
    find (\(key, value) -> value == searchName) itemsTable -- (1)
  >>= \itemId -> -- (3)
    lookup itemId linkingTable -- (4)
  >>= \categoryId -> -- (5)
    lookup categoryId categoriesTable -- (6)

fst применяется к значению “под” Just, либо результат – Nothing, если аргумент – Nothing. Результат Just key или Nothing.
Первый оператор >>=.

Если результат (2) – Nothing, то результат всего выражения – Nothing и вычисление прерывается.

Иначе, значение под Just передаётся в функцию \itemId -> ....

linkingTable :: [(ItemId, CatId)]

getCategoryForItem searchName =
  fst <$> -- (2)
    find (\(key, value) -> value == searchName) itemsTable -- (1)
  >>= \itemId -> -- (3)
    lookup itemId linkingTable -- (4)
  >>= \categoryId -> -- (5)
    lookup categoryId categoriesTable -- (6)

По определению lookup, значение Nothing или Just catId.
Если (4) == Nothing, результат – Nothing, иначе – значение catId передаётся в функцию \categoryId -> ...
Результат – lookup categoryId categoriesTable.

getCategoryForItem searchName =
  fst <$> -- (2)
    find (\(key, value) -> value == searchName) itemsTable -- (1)
  >>= \itemId -> -- (3)
    lookup itemId linkingTable -- (4)
  >>= \categoryId -> -- (5)
    lookup categoryId categoriesTable -- (6)

Таким образом, если какой-то из промежуточных шагов вычисления возвращает Nothing, то вычисление прерывается и результат – Nothing. В противном случае, значение под Just передаётся дальше.

`Either a`

data  Either a b  =  Left a | Right b

Минимальное определение:

instance Functor (Either a) where
    fmap _ (Left x) = Left x
    fmap f (Right y) = Right (f y)

instance Applicative (Either e) where
    pure          = Right
    Left  x <*> _ = Left x
    Right f <*> r = fmap f r

instance Monad (Either e) where
    Left  x >>= _ = Left x
    Right r >>= k = k r

Сравнивая с Maybe, разница только в том, что вместо Nothing используется Left x, а вместо Just – Right.

Моделирует “ошибки с описанием”. Можно написать функции

catchError :: Either e a -> (e -> Either e' a) -> Either e' a
catchError (Left  l) handler = handler l
catchError (Right r) _ = Right r

throwError :: e -> Either e a
throwError = Left

и использовать их для проброса исключений.

Очень многословный вариант на тему кода выше:

getCategoryForItem'' :: ItemName -> Either String CategoryName
getCategoryForItem'' searchName = do
  let mItemId = fst
        <$> find (\(key, value) -> value == searchName) itemsTable
  case mItemId of
    Nothing -> throwError "Item not found"
    Just itemId -> do
      let mCategoryId = lookup itemId linkingTable
      case mCategoryId of
        Nothing -> throwError "Category for item not found"
        Just catId -> do
          let mCategoryName = lookup catId categoriesTable
          case mCategoryName of
            Nothing -> throwError "Category not found"
            Just catName -> pure catName

То же гораздо проще:

getCategoryForItem'' :: ItemName -> Either String CategoryName
getCategoryForItem'' searchName = do
  itemId <- fst
    <$> find (\(key, value) -> value == searchName) itemsTable
    `onError` "Item not found"
  categoryId <- lookup itemId linkingTable
    `onError` "Category for item not found"
  lookup categoryId categoriesTable
    `onError` "Category not found"
  where
  infix 0 `onError`
  onError Nothing  msg = throwError msg
  onError (Just x) msg = pure x

`[]`

Минимальное определение:

instance Functor [] where
    fmap = map

instance Applicative [] where
    pure x    = [x]
    fs <*> xs = concatMap (\f -> map f xs) fs

instance Monad []  where
    xs >>= f = concatMap f xs

Недетерминированный конечный автомат без ε-переходов:

type NFAState = Word

runNFA :: (NFAState -> Char -> [NFAState])
       ->  NFAState -> [Char] -> [NFAState]
runNFA _               _            [] = []
runNFA transitionTable initialState (ch:restOfInput) = do
  nextState <- transitionTable initialState ch
  runNFA transitionTable nextState restOfInput

или используя foldlM:

type NFAState = Word

runNFA :: (NFAState -> Char -> [NFAState])
       ->  NFAState -> [Char] -> [NFAState]
runNFA = foldlM
-- runNFA transitionTable initialState input
--   = foldlM transitionTable initialState input

`(,) a`

Минимальное определение:

instance Functor ((,) a) where
    fmap f (x,y) = (x, f y)

instance Monoid a => Applicative ((,) a) where
    pure x = (mempty, x)
    (u, f) <*> (v, x) = (u <> v, f x)

instance Monoid a => Monad ((,) a) where
    (u, a) >>= k = let (v, b) = k a in (u <> v, b)

`Writer w`

Более общепринятое название пары – Writer.

Операции, которые могут “записывать” что-то в процессе работы. Пара – не единственный вариант реализации.

Будем называть элемент, являющийся моноидом (в котором хранится то, что “записывают” вычисления) – “выводом”.

Монады, являющиеся Writer объединяются в класс MonadWriter, определённый в пакете mtl в модуле Control.Monad.Writer.Class.

Все монады в MonadWriter поддерживают операции:

writer :: MonadWriter w m => (a, w) -> m a
tell :: MonadWriter w m => w -> m ()
listen :: MonadWriter w m => m a -> m (a, w)
pass :: MonadWriter w m => m (a, w -> w) -> m a

Для удобства вводится также функция

censor :: MonadWriter w m => (w -> w) -> m a -> m a

Типовый представитель – Writer w a, объявлен в модуле Control.Monad.Writer.

Вычисления в Writer w a производятся при помощи функции

runWriter :: Monoid w => Writer w a -> (a, w)

`(->) a`

instance Functor ((->) r) where
    fmap = (.)

instance Applicative ((->) a) where
    pure = const
    liftA2 q f g = \x -> q (f x) (g x)

instance Monad ((->) r) where
    f >>= k = \r -> k (f r) r

`Reader`

Более общепринятое называние монады функций – Reader. Операции, которые могут “читать”, но не изменять, некое “окружение”, передаваемое аргументом функции. Функция – не единственная возможная реализация.

Все монады Reader объединяются в класс MonadReader, определённый в пакете mtl в модуле Control.Monad.Reader.Class.

Все монады в MonadReader поддерживают функции:

ask :: MonadReader r m => m r
local :: MonadReader r m => (r -> r) -> m a -> m a
reader :: MonadReader r m => (r -> a) -> m a

Для удобства:

asks :: MonadReader r m => (r -> b) -> m b

Типовый представитель – Reader r a, объявлен в модуле Control.Monad.Reader.

Вычисления в Reader r a производятся при помощи

runReader :: Reader r a -> r -> a

Пример:

import Debug.Trace
import Control.Monad.Reader
data MyEnv = MyEnv {
    showDebug :: Bool
  , showResult :: Bool
  }
type MyEnvRdr a = Reader MyEnv a
runSomeOperation :: Int -> Int -> MyEnvRdr Int
runSomeOperation x y = do
  debug <- asks showDebug
  when debug $ traceM (
    "called runSomeOperation with " <> show x <> "," <> show y)
  result <- asks showResult
  when result $ traceM ("result is " <> show (x+y))
  return (x+y)

`State`

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

Параллели с Reader и Writer.

instance Functor (State s) where
    fmap f x = State $ \s ->
        let (a, s') = runState x s
        in (f a, s')
instance Applicative (State s) where
    pure a = State $ \s -> (a, s)
    State f <*> State x = State $ \ s ->
      let (f, s') = f s
          (x, s'') = x s'
      in (f x, s'')
instance (Monad m) => Monad (State s) where
  m >>= k  = State $ \s ->
      let (a, s') = runState m s
      in runState (k a) s'

Не единственный вариант реализации.

Все монады State объединяются в класс MonadState, определённый в пакете mtl в модуле Control.Monad.State.Class.

Все монады в MonadState поддерживают функции:

get :: MonadState m s => m s
put :: MonadState m s => s -> m ()
state :: MonadState m s => (s -> (a, s)) -> m a

Для удобства:

gets :: MonadState m s => (s -> a) -> m a
modify :: MonadState m s => (s -> s) -> m ()

Вычисления в State s a производятся при помощи функции

runState :: State s a -> s -> (a, s)

Кроме того есть функции

evalState :: State s a -> s -> a
execState :: State s a -> s -> s

С помощью State можно моделировать любые процессы с изменяемым состоянием. Например, ДКА:

type DFAState = Word

runDFA :: (Char -> DFAState -> DFAState)
       -> [Char]
       -> State DFAState ()
runDFA transitionTable [] = pure ()
runDFA transitionTable (ch:restOfInput) = do
  modify (transitionTable ch)
  runDFA transitionTable restOfInput

или, используя mapM_

runDFA :: (Char -> DFAState -> DFAState)
       -> [Char]
       -> State DFAState ()
runDFA tt = mapM_ (modify . tt)
-- эквивалентно
-- runDFA transitionTable input
--   = mapM_ (modify . transitionTable) input

`ST`

Мы переходим к “магическим” монадам. Не определяются в терминах стандартного Haskell. Задача – обеспечить взаимодействие с “внешним миром”.

Монада ST абстрагирует работу с изменяемой памятью. Императивные переменные и массивы.

Обычно, ST не нужна. Но некоторые алгоритмы значительно проще (и эффективнее!) в императивной парадигме. Иногда – очень удобно.

С сугубо теоретической точки зрения, ST не отличается State. Но реализация – сильно разная.

Основные функции для работы с изменяемыми значениями в монаде ST:

newSTRef :: a -> ST s (STRef s a)
readSTRef :: STRef s a -> ST s a
writeSTRef :: STRef s a -> a -> ST s ()

`IO`

IO абстрагирует взаимодействие “внешним миром”. В целом сводится к вводу-выводу.

Можно думать как о более сложном варианте ST. В качестве “состояния” используется RealWorld – “внешний мир”.

RealWorld – фикция: на самом деле никакого RealWorld в скомпилированной программе нет (в отличие от State и ST).

IO сигнализирует компилятору строгий порядок операций и запрет многих оптимизаций (возможных в “чистом” коде).

Значение, имеющее тип IO a – инструкция, как получить a, взаимодействуя с внешним миром.

Эта инструкция – “чистая”, не имеет побочных эффектов. Можно передавать как значение, можно совершать манипуляции, и т.п.

Будет выполнена тогда и только тогда, когда будет объединена с IO в main. Тогда возникнут все связанные побочные эффекты.

“Объединение” означает следующее. В модуле Control.Monad объявлена функция join:

join   :: (Monad m) => m (m a) -> m a
join x = x >>= id

Убирает один уровень вложенности монады m. Это формальное определение “объединения” для монады.

Когда действие IO a передаётся в вычисление, которое в конце-концов попадает в результат функции main, действие выполняется.

В качестве примера, рассмотрим два фрагмента кода:

main :: IO ()
main = do
  let action = putStrLn "Hello, World!"
  return ()

Этот код ничего не делает – вызов putStrLn никогда не объединяется с IO в main. Действительно, если записать этот код без do-нотации, то получится

main :: IO ()
main = let action = putStrLn "Hello, World!" in return ()

main :: IO ()
main = do
  action <- putStrLn "Hello, World!"
  return ()

Этот код выведет строку Hello, World!, поскольку, если убрать do-нотацию, мы увидим:

main :: IO ()
main = putStrLn "Hello, World!" >>= \action -> return ()

значение action не используется, но действие, необходимое для получения этого значения (а именно, putStrLn "Hello, World!") должно быть выполнено, поскольку оно объединяется с результатом main оператором >>=.

Первый код можно исправить следующим образом:

main :: IO ()
main = do
  let action = putStrLn "Hello, World!"
  action
  return ()

Без do-нотации:

main = let action = putStrLn "Hello, World!"
       in action >>= \_ -> return ()

или, эквивалентно

main = let action = putStrLn "Hello, World!"
       in action >> return ()