Почему мы должны использовать монаду состояния вместо прямой передачи состояния?

Передача состояния часто утомительна, подвержена ошибкам и мешает рефакторингу. Например, попробуйте пометить двоичное дерево или розовое дерево в почтовом порядке:

data RoseTree a = Node a [RoseTree a] deriving (Show)

postLabel :: RoseTree a -> RoseTree Int
postLabel = fst . go 0 where
  go i (Node _ ts) = (Node i' ts', i' + 1) where

    (ts', i') = gots i ts

    gots i []     = ([], i)
    gots i (t:ts) = (t':ts', i'') where
      (t', i')   = go i t
      (ts', i'') = gots i' ts

Здесь мне пришлось вручную пометить состояния в правильном порядке, передать правильные состояния и убедиться, что и метки, и дочерние узлы находятся в правильном порядке в результате (обратите внимание, что наивное использование foldr или foldl для дочерних узлов узлы могли легко привести к неправильному поведению).

Кроме того, если я попытаюсь изменить код на предзаказ, мне придется внести изменения, в которых легко ошибиться:

preLabel :: RoseTree a -> RoseTree Int
preLabel = fst . go 0 where
  go i (Node _ ts) = (Node i ts', i') where -- first change

    (ts', i') = gots (i + 1) ts -- second change

    gots i []     = ([], i)
    gots i (t:ts) = (t':ts', i'') where
      (t', i')   = go i t
      (ts', i'') = gots i' ts

Примеры:

branch = Node ()
nil  = branch []
tree = branch [branch [nil, nil], nil]
preLabel tree == Node 0 [Node 1 [Node 2 [],Node 3 []],Node 4 []]
postLabel tree == Node 4 [Node 2 [Node 0 [],Node 1 []],Node 3 []]

Сравните решение монады состояния:

import Control.Monad.State
import Control.Applicative

postLabel' :: RoseTree a -> RoseTree Int
postLabel' = (`evalState` 0) . go where
  go (Node _ ts) = do
    ts' <- traverse go ts
    i   <- get <* modify (+1)
    pure (Node i ts')

preLabel' :: RoseTree a -> RoseTree Int
preLabel' = (`evalState` 0) . go where
  go (Node _ ts) = do
    i   <- get <* modify (+1)
    ts' <- traverse go ts
    pure (Node i ts')

Этот код не только более лаконичен и его легче писать правильно, но и логика, которая приводит к маркировке до или после заказа, намного более прозрачна.

PS: бонусный аппликационный стиль:

postLabel' :: RoseTree a -> RoseTree Int
postLabel' = (`evalState` 0) . go where
  go (Node _ ts) =
    flip Node <$> traverse go ts <*> (get <* modify (+1))

preLabel' :: RoseTree a -> RoseTree Int
preLabel' = (`evalState` 0) . go where
  go (Node _ ts) =
    Node <$> (get <* modify (+1)) <*> traverse go ts

В качестве примера к моему комментарию выше, вы можете написать код, используя монаду State, например

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Text (Text)
import qualified Data.Text as Text
import Control.Monad.State

data MyState = MyState
    { _count :: Int
    , _messages :: [Text]
    } deriving (Eq, Show)
makeLenses ''MyState

type App = State MyState

incrCnt :: App ()
incrCnt = modify (\my -> my & count +~ 1)

logMsg :: Text -> App ()
logMsg msg = modify (\my -> my & messages %~ (++ [msg]))

logAndIncr :: Text -> App ()
logAndIncr msg = do
    incrCnt
    logMsg msg

app :: App ()
app = do
    logAndIncr "First step"
    logAndIncr "Second step"
    logAndIncr "Third step"
    logAndIncr "Fourth step"
    logAndIncr "Fifth step"

Обратите внимание, что использование дополнительных операторов из Control.Lens также позволяет записывать incrCnt и logMsg как

incrCnt = count += 1

logMsg msg = messages %= (++ [msg])

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

incrCnt :: MyState -> MyState
incrCnt my = my & count +~ 1

logMsg :: MyState -> Text -> MyState
logMsg my msg = my & messages %~ (++ [msg])

logAndIncr :: MyState -> Text -> MyState
logAndIncr my msg =
    let incremented = incrCnt my
        logged = logMsg incremented msg
    in logged

На данный момент это не так уж плохо, но как только мы перейдем к следующему шагу, я думаю, вы увидите, где на самом деле возникает дублирование кода:

app :: MyState -> MyState
app initial =
    let first_step  = logAndIncr initial     "First step"
        second_step = logAndIncr first_step  "Second step"
        third_step  = logAndIncr second_step "Third step"
        fourth_step = logAndIncr third_step  "Fourth step"
        fifth_step  = logAndIncr fourth_step "Fifth step"
    in fifth_step

Еще одно преимущество обертывания этого экземпляра Monad состоит в том, что вы можете использовать с ним всю мощь Control.Monad и Control.Applicative:

app = mapM_ logAndIncr [
    "First step",
    "Second step",
    "Third step",
    "Fourth step",
    "Fifth step"
    ]

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

Разница между передачей состояния вручную и использованием монады State просто в том, что монада State является абстракцией над ручным процессом. Это также соответствует нескольким другим широко используемым более общим абстракциям, таким как Monad, Applicative, Functor и некоторым другим. Если вы также используете преобразователь StateT, вы можете скомпоновать эти операции с другими монадами, такими как IO. Сможете ли вы сделать все это без State и StateT? Конечно, можете, и никто не мешает вам это сделать, но дело в том, что State абстрагирует этот шаблон и дает вам доступ к огромному набору инструментов более общего характера. Кроме того, небольшая модификация приведенных выше типов заставляет одни и те же функции работать в разных контекстах:

incrCnt :: MonadState MyState m => m ()
logMsg :: MonadState MyState m => Text -> m ()
logAndIncr :: MonadState MyState m => Text -> m ()

Теперь они будут работать с App, или с StateT MyState IO, или с любым другим стеком монад с реализацией MonadState. Это делает его значительно более удобным для повторного использования, чем простая передача аргументов, которая возможна только через абстракцию StateT.

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

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

(На основе кода, который в настоящее время находится в разработке, с измененными названиями и деталями того, что эта служба на самом деле скрывает)

{-# LANGUAGE OverloadedStrings #-}

module XmpConfig where

import Data.IORef
import Control.Arrow (first)
import Control.Monad
import qualified Data.Text as T
import Data.Aeson hiding ((.=))
import qualified Data.HashMap.Strict as MS
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (execStateT, StateT, gets, modify)
import qualified Data.Foldable as DF
import Data.Maybe (fromJust, isJust)

data Taggy = UseTags Bool | NoTags
newtype Locale = Locale String

data MyServiceConfig = MyServiceConfig {
    _mscTagStatus :: Taggy
  , _mscFlipResult :: Bool
  , _mscWasteTime :: Bool
  , _mscLocale :: Locale
  , _mscFormatVersion :: Int
  , _mscJobs :: [String]
  }

baseWebConfig :: IO (IORef [String], IORef [String], MyServiceConfig)
baseWebConfig = do
  infoRef <- newIORef []
  warningRef <- newIORef []
  let cfg = MyServiceConfig {
        _mscTagStatus = NoTags
        , _mscFlipResult = False
        , _mscWasteTime = False
        , _mscLocale = Locale "en-US"
        , _mscFormatVersion = 1
        , _mscJobs = []
        }
  return (infoRef, warningRef, cfg)

parseLocale :: T.Text -> Maybe Locale
parseLocale = Just . Locale . T.unpack  -- The real thing does more

parseJSONReq :: MS.HashMap T.Text Value ->
                IO (IORef [String], IORef [String], MyServiceConfig)
parseJSONReq m = liftM snd
                 (baseWebConfig >>= (\c -> execStateT parse' (m, c)))
  where
    parse' :: StateT (MS.HashMap T.Text Value,
                      (IORef [String], IORef [String], MyServiceConfig))
              IO ()
    parse' = do
      let addWarning s = do let snd3 (_, b, _) = b
                            r <- gets (snd3 . snd)
                            liftIO $ modifyIORef r (++ [s])
          -- These two functions suck a key/value off the input map and
          -- pass the value on to the handler "h"
          onKey      k h = onKeyMaybe k $ DF.mapM_ h
          onKeyMaybe k h = do myb <- gets fst
                              modify $ first $ MS.delete k
                              h (MS.lookup k myb)
          -- Access the "lns" field of the configuration
          config setter = modify (\(a, (b, c, d)) -> (a, (b, c, setter d)))

      onKey "tags" $ \x -> case x of
        Bool True ->       config $ \c -> c {_mscTagStatus = UseTags False}
        String "true" ->   config $ \c -> c {_mscTagStatus = UseTags False}
        Bool False ->      config $ \c -> c {_mscTagStatus = NoTags}
        String "false" ->  config $ \c -> c {_mscTagStatus = NoTags}
        String "inline" -> config $ \c -> c {_mscTagStatus = UseTags True}
        q -> addWarning ("Bad value ignored for tags: " ++ show q)
      onKey "reverse" $ \x -> case x of
        Bool r -> config $ \c -> c {_mscFlipResult = r}
        q -> addWarning ("Bad value ignored for reverse: " ++ show q)
      onKey "spin" $ \x -> case x of
        Bool r -> config $ \c -> c {_mscWasteTime = r}
        q -> addWarning ("Bad value ignored for spin: " ++ show q)
      onKey "language" $ \x -> case x of
        String s | isJust (parseLocale s) ->
          config $ \c -> c {_mscLocale = fromJust $ parseLocale s}
        q -> addWarning ("Bad value ignored for language: " ++ show q)
      onKey "format" $ \x -> case x of
        Number 1 -> config $ \c -> c {_mscFormatVersion = 1}
        Number 2 -> config $ \c -> c {_mscFormatVersion = 2}
        q -> addWarning ("Bad value ignored for format: " ++ show q)
      onKeyMaybe "jobs" $ \p -> case p of
        Just (Array x) -> do q <- parseJobs x
                             config $ \c -> c {_mscJobs = q}
        Just (String "test") ->
          config $ \c -> c {_mscJobs = ["test1", "test2"]}
        Just other -> fail $ "Bad value for jobs: " ++ show other
        Nothing    -> fail "Missing value for jobs"
      m' <- gets fst
      unless (MS.null m') (fail $ "Unrecognized key(s): " ++ show (MS.keys m'))

    parseJobs :: (Monad m, DF.Foldable b) => b Value -> m [String]
    parseJobs = DF.foldrM (\a b -> liftM (:b) (parseJob a)) []
    parseJob :: (Monad m) => Value -> m String
    parseJob (String s) = return (T.unpack s)
    parseJob q = fail $ "Bad job value: " ++ show q