2015-07-17 3 views
8

Может ли кто-нибудь показать простой пример, где государственная монада может быть лучше, чем передача состояния напрямую?Почему мы должны использовать государственную монаду вместо передачи состояния напрямую?

bar1 (Foo x) = Foo (x + 1) 

против

bar2 :: State Foo Foo 
bar2 = do 
    modify (\(Foo x) -> Foo (x + 1)) 
    get 
+1

Скорее всего, вам придется переопределить многие функции, уже предлагаемые монадой 'State'. Подумайте о последнем как о шаблоне проектирования. Вы также можете легко совместить 'State' с другими монадами. – Jubobs

+0

Но если я не использую State, мне не нужно сочетать его с другими монадами. Я бы предпочел некоторые примеры кода. – ais

+1

Ну, в примере, который вы даете, использование 'State', вероятно, слишком велико. У вас есть конкретный, реальный пример? – Jubobs

ответ

13

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

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') 

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


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 
+1

Это отличный пример. – Jubobs

+0

не должен '(get <*> изменить (+1))' в аппликативной 'preLabel'' быть' (get <* modify (+1)) '? – pat

+0

@pat да, опечатка. –

0

По моему опыту, точка многих монад не очень нажмите, пока вы не получите в более крупные примеры, так вот пример использования 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 
5

В качестве примера на мой comment выше, вы можете написать код, используя 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.

Смежные вопросы