有人可以展示一个简单的例子，其中状态monad可能比直接传递状态更好吗？
bar1 (Foo x) = Foo (x + 1)
VS
bar2 :: State Foo Foo
bar2 = do
modify (\(Foo x) -> Foo (x + 1))
get
答案 0 :(得分：15)
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
在这里，我必须以正确的顺序手动标记状态，传递正确的状态，并且必须确保标签和子节点在结果中的顺序正确（请注意，{{1子节点或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
对比州状monad解决方案：
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 []]
这个代码不仅更简洁，更容易正确编写，导致标记前后序列的逻辑更加透明。
PS：奖金适用风格：
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')
答案 1 :(得分：5)
作为上述comment的示例，您可以使用State monad编写代码，例如
{-# 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 monad之间的区别仅在于State monad是手动过程的抽象。它恰好适用于其他一些广泛使用的更一般的抽象，例如Monad，Applicative，Functor和其他几个。如果您还使用StateT转换器，则可以使用其他monad组合这些操作，例如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实施的monad堆栈。它使得它比简单的参数传递更加可重用，这只能通过StateT的抽象来实现。
答案 2 :(得分：1)
根据我的经验，许多Monads的观点并没有真正点击，直到你进入更大的例子，所以这里有一个使用State（好吧，StateT ... IO）解析一个例子的例子。传入Web服务请求。
模式是可以使用不同类型的一组选项调用此Web服务，但除了其中一个选项之外的所有选项都具有合适的默认值。如果我收到带有未知密钥值的传入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