2015-07-17 10 views
8

Kann jemand ein einfaches Beispiel zeigen, in dem die Zustandsmonade besser sein kann als den Zustand direkt zu übergeben?Warum müssen wir State Monad anstelle von State direkt verwenden?

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

vs

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

Wahrscheinlich müssen Sie viele der Funktionen, die bereits von der 'State'-Monade angeboten werden, neu implementieren. Stellen Sie sich Letzteres als Designmuster vor. Sie können "State" auch einfach mit anderen Monaden kombinieren. – Jubobs

+0

Aber wenn ich State nicht verwende, muss ich es nicht mit anderen Monaden kombinieren. Ich würde einige Codebeispiele bevorzugen. – ais

+1

Nun, in dem Beispiel, das Sie geben, ist die Verwendung von "State" wahrscheinlich zu viel. Hast du ein konkretes Beispiel aus der Praxis? – Jubobs

Antwort

13

Staat Gang ist oft langwierig und fehleranfällig und behindert Refactoring. Zum Beispiel versuchen, einen binären Baum oder Rosenbaum in Postorder-Kennzeichnung:

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 

Hier hatte ich manuell Zustände in der richtigen Reihenfolge zu kennzeichnen, übergeben Sie die richtigen Zustände entlang und musste sicherstellen, dass sowohl die Etiketten und Kind Knoten befinden sich in der richtigen Reihenfolge im Ergebnis (beachten Sie, dass die naive Verwendung von foldr oder foldl für die untergeordneten Knoten leicht zu falschem Verhalten führen könnte).

Auch, wenn ich versuche, den Code zu ändern vorzubestellen, muss ich Änderungen vornehmen, die falsch leicht zu bekommen sind:

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 

Beispiele:

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 []] 

Kontrast der Zustand Monade Lösung:

Nicht nur ist dieser Code prägnanter und einfacher zu schreiben, die Logik, die sich daraus ergibt s in der Kennzeichnung vor oder nach der Bestellung ist viel transparenter.


PS: Bonus applicative Stil:

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

Dies ist ein großartiges Beispiel. – Jubobs

+0

sollte nicht '(erhalten <*> ändern (+1))' in der applicative 'preLabel'' sein '(<* modify (+1))' bekommen? – pat

+0

@pat ja, Tippfehler. –

0

Nach meiner Erfahrung ist der Punkt von vielen Monaden nicht wirklich klicken, bis Sie in größere Beispiele zu bekommen, ist so hier ein Beispiel für die Verwendung von State (Nun, StateT ... IO), um eine eingehende Anfrage an einen Webservice zu analysieren.

Das Muster ist, dass dieser Web-Service mit einer Reihe von Optionen verschiedener Typen aufgerufen werden kann, obwohl alle außer einer der Optionen anständige Standardwerte haben. Wenn ich eine eingehende JSON-Anfrage mit einem unbekannten Schlüsselwert erhalte, sollte ich mit einer entsprechenden Nachricht abbrechen. Ich verwende den Status, um zu verfolgen, was die aktuelle Konfiguration ist und was der Rest der JSON-Anfrage ist, zusammen mit einer Reihe von Zugriffsmethoden.

(Basierend auf Code derzeit in der Produktion, mit den Namen der alles verändert und die Details von dem, was dieser Dienst tatsächlich verdeckt ist)

{-# 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

Als Beispiel meines comment oben, können Sie Code mit dem Schreib State Monade wie

{-# 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" 

Beachten Sie, dass die Verwendung zusätzlicher Betreiber von Control.Lens können auch schreiben Sie incrCnt und logMsg als

incrCnt = count += 1 

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

, die einen anderen Vorteil der Zusammenarbeit mit der lens Bibliothek State in Kombination ist, aber für die Zwecke des Vergleichs ich nicht mit ihnen in diesem Beispiel.So schreiben Sie das Bestehen der entsprechende Code oben mit nur Argument wäre es eher wie

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 

An dieser Stelle ist es nicht so schlimm ist, aber sobald wir in den nächsten Schritt bekommen ich denke, Sie werden sehen, wo der Code-Duplizierung wirklich kommt in:

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 

ein weiterer Vorteil dieses in einer Monad Instanz Einwickeln ist, dass Sie die volle Leistung des Control.Monad und Control.Applicative damit verwenden können:

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

Dies ermöglicht viel mehr Flexibilität bei der Verarbeitung von Werten, die zur Laufzeit im Vergleich zu statischen Werten berechnet werden.

Der Unterschied zwischen der manuellen Statusübergabe und der Verwendung der State Monade ist einfach, dass die State Monade eine Abstraktion über den manuellen Prozess ist. Es passt auch zu einigen anderen allgemeineren Abstraktionen, wie Monad, Applicative, Functor und einigen anderen. Wenn Sie auch den StateT Transformer verwenden, können Sie diese Operationen mit anderen Monaden zusammenstellen, z. B. IO. Können Sie all dies ohne State und StateT tun? Natürlich kannst du das, und es gibt niemanden, der dich davon abhält, aber der Punkt ist, dass State dieses Muster abstrahiert und dir Zugriff auf eine riesige Toolbox mit allgemeineren Werkzeugen gibt. Auch eine kleine Änderung an den oben genannten Typen macht die gleichen Funktionen in mehreren Kontexten arbeiten:

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

Diese jetzt mit App oder mit StateT MyState IO oder einem anderen Monade Stapel mit einer MonadState Implementierung arbeiten. Es macht es deutlich mehr wiederverwendbar als einfache Argumentübergabe, was nur durch die Abstraktion möglich ist, die StateT ist.