“通过”和“倾听”如何在 WriterT 中工作

Question

下面的代码可能不是一个好方法，但这是我设法拼凑起来的。基本上，我运行一系列复杂的任务，在此期间记录了几件事。在每次结束时，我将日志转储到.txt文件中，然后循环进入下一批。

为了实现这一目标，我在WriterT中使用了listen和pass(作为RWST的一部分(。代码如下：

-- Miscelaneous stuff
newtype Log = Log [String]
type ConnectT a = EitherT String (RWST ConnectReader Log ConnectState IO) a
timeStampLog :: String -> Log
timeStampLog msg = do
    theTime <- liftIO $ fmap zonedTimeToLocalTime getZonedTime
    let msgStart = show theTime ++ ": "
    tell $ Log [msgStart ++ msg]
logToFileIO :: Log -> IO ()
logToFileIO (Log xs) = appendFile "Log.txt" $ "rn" ++ intercalate "rn" (reverse xs)
---------------------

logToFile :: ConnectT a -> ConnectT ()
logToFile cta = let ctaw = listen cta
                in  pass $ do
                                (_,w) <- ctaw
                                liftIO $ logToFileIO w
                                return ((),const mempty)
mapFunction :: (Show a) => a -> ConnectT ()
mapFunction a = logToFile $ do
    timeStampLog $ "Starting sequence for " ++ show a
    lotsOfLogging a
    timeStampLog $ "Finishing sequence for " ++ show a
loopFunction :: ConnectT ()
loopFunction = logToFile $ do
    timeStampLog "Starting Loop"
    mapM_ mapFunction someList
    timeStampLog "Finishing Loop"

我最终得到的是这样的：

2015-03-17 20:21:40.8198823: Starting sequence for a
2015-03-17 20:21:41.8198823: (logs for a)
2015-03-17 20:21:41.8198823: Finishing sequence for a
2015-03-17 20:21:41.8198823: Starting sequence for b
2015-03-17 20:21:42.8198823: (logs for b)
2015-03-17 20:21:42.8198823: Finishing sequence for b
2015-03-17 20:21:39.8198823: Starting Loop
2015-03-17 20:21:42.8198823: Finishing Loop

其中，用于开始/完成循环的日志条目在末尾一起结束。

对于在mapFunction中调用logToFile不包括来自loopFunction的日志信息，我并不完全感到惊讶，因为该信息尚未通过绑定传递给它。

但我仍然难以理解pass和listen是如何工作的。以及我将如何解决这个(诚然是次要的(问题。

Answer 1

我们可以几乎完全从它们的类型来确定listen和pass的工作方式。我们将从倾听开始。

听

listen :: (Monoid w, Monad m) => RWST r w s m a -> RWST r w s m (a, w)

解开我们拥有的RWST

listen :: (Monoid w, Monad m) => (r -> s -> m (a, s, w)) -> r -> s -> m ((a, w), s, w)

它需要返回一个m ...。我们必须制作m的唯一方法是return某些东西或将输入函数应用于r和s(我们不能使用 >>=，因为它要求我们已经有一个m(。我们没有要返回的a，因此我们必须将该函数应用于r并s 。我们只能使用一种r和s，即传递到结果中的那些。

listen k r s = ... (k r s) 

现在我们有m (a, s, w)，但需要一个m ((a, w), s, w)。我们可以再次运行该操作以获得另一个m("listen ing"的废话(或对m内的(a, s, w)执行某些操作 >>= .

listen k r s = k r s >>= (a, s' w) -> ...

要使用bind我们需要一个 m .我们可以返回一些东西，也可以将输入函数应用于r并s并再次重复该操作，这对于" listen ing"来说是无稽之谈。我们return一些东西。

listen k r s = k r s >>= (a, s', w) -> return ...

我们需要一个a，一个w，一个s，以及另一个w。我们只有一个a，没有办法得到任何其他。

listen k r s = k r s >>= (a, s', w) -> return ((a,...),...,...)

我们有 3 种方法可以得到w：mempty，动作结果的w，或将两个w与<>组合在一起。返回mempty毫无意义;用户可能只是自己使用mempty。复制用<>记录的内容与运行两次操作一样无稽之谈，因此我们返回第一个操作记录的内容。

listen k r s = k r s >>= (a, s', w) -> return ((a,w),...,...)

我们有两个s：s和s'。还原动作的状态变化对于"listen ing"来说是无稽之谈，所以我们返回更改后的状态s'。

listen k r s = k r s >>= (a, s', w) -> return ((a,w),s',...)

现在我们面临着唯一有趣的选择：我们应该为记录的内容保留什么w？用户对记录的内容进行了"listen编辑";我们可以说现在是他们的问题，并将日志重置为 mempty .但是"listen"并不是说它应该改变某事的作用，它应该只观察它。因此，我们保持生成的日志w不变。

listen k r s = k r s >>= (a, s', w) -> return ((a,w),s',w)

如果我们再次将其包装在它的RWST中，我们有

listen m = RWST r s -> (runRWST m) r s >>= (a, s', w) -> return ((a,w),s',w)

我们所做的只是运行输入操作，并将其记录的内容及其生成的a作为元组包含在结果中。这与 listen 的文档匹配：

listen m 是一个操作，它执行操作m并将其输出添加到计算值。

runRWST (listen m) r s = liftM ( (a, w) -> ((a, w), w)) (runRWST m r s)

告诉

pass :: (Monoid w, Monad m) => RWST r w s m (a, w -> w) -> RWST r w s m a

我们像以前一样开始，展开RWST

pass :: (Monoid w, Monad m) => (r -> s -> m ((a, w->w), s, w)) -> r -> s -> m (a, s, w)

对于如何获得结果m，我们遵循与listen相同的论点

pass k r s = ... (k r s)

现在我们有一个m ((a, w->w), s, w))，但需要一个m (a, s, w) .我们可以再次运行该操作以获得另一个m("pass ing"的废话(或对m内的((a, w->w), s, w)做一些事情 >>= .

pass k r s = k r s >>= ((a, f), s', w) -> ...

要使用bind我们需要一个 m .我们可以返回一些东西，也可以将输入函数应用于r并s并再次重复该操作，这对于" pass ing"来说是无稽之谈。我们return一些事情。

pass k r s = k r s >>= ((a, f), s', w) -> return ...

我们需要一个a、一个s和一个w。我们只有一个a，没有办法得到任何其他

。

pass k r s = k r s >>= ((a, f), s', w) -> return (a,...,...)

我们有两个s：s和s'。还原动作的状态变化对于"pass ing"来说是无稽之谈，所以我们返回更改的状态s'。

pass k r s = k r s >>= ((a, f), s', w) -> return (a,s',...)

有4种方法可以得到一个w：mempty，从动作结果中w，将两个w与<>组合在一起，或将函数f应用于另一个w。将结果设置为 mempty 让我们想知道为什么用户提供函数f :: w -> w .他们自己。复制用<>记录的内容与运行两次操作一样无稽之谈。我们应该将函数f应用于某些东西。

pass k r s = k r s >>= ((a, f), s', w) -> return (a,s',f ...)

我们可以将f应用于由mempty s和<>构建的东西，但如果是这样的话，所有的f s都等价于const ...;它的类型也可以是一个w。我们可以将f应用于由w、mempty、<>和f构建的复杂结构，但是如果我们简单地将其传递w，所有这些结构都可以在f本身中定义。

pass k r s = k r s >>= ((a, f), s', w) -> return (a,s',f w)

如果我们再次将其包装在它的RWST中，我们有

pass m = RWST r s -> (runRWST k) r s >>= ((a, f), s', w) -> return (a,s',f w)

我们运行了输入操作并更改了作为操作结果的函数记录的内容。这与 pass 的文档匹配：

pass m 是执行操作m 的操作，它返回一个值和一个函数，并返回值，将函数应用于输出。

runRWST (pass m) r s = liftM ( ((a, f), w) -> (a, f w)) (runRWST m r s)

Answer 2

在运行操作并组装w之前，现有WriterT w m无法在基础m中执行任何操作来执行日志记录。正如你的问题所说明的，这是令人困惑的。do块loopFunction的日志在do块本身完成运行之前不会由logToFile写入。

记录器

让我们发明一种名为 LoggerT 的新WriterT。我们的新LoggerT将提供新功能

logTells :: (Monoid w, Monoid w', Monad m) =>
            (w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a

这背后的直觉是：我们将能够提供一个动作(类型为w -> LoggerT w' m ()(来记录每个tell，将记录的结果替换为动作的结果。如果我们把用户tell的两件事都砸碎<>我们将无法再记录它们;我们永远只能记录<>的结果。由于我们的LoggerT永远无法使用<>因此它永远不需要Monoid实例。我们必须从LoggerT中的所有内容中删除Monoid约束。

logTells :: (Monad m) =>
            (w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a

我们需要记住每一项tell，以便以后可以更换它。但是当我们"稍后"替换它时，日志记录应该在代码中出现tell点发生。例如，如果我们使

processX :: LoggerT String m ()
processX = do
    tell "Starting process X"
    lotsOfProcessing
    tell "Finishing process X"

然后"稍后"写入logTells logToFile processX我们希望生成的计算如下所示。

logTells logToFile processX = do
    logToFile "Starting process X"
    lotsOfProcessing
    logToFile "Finishing process X"

在tell "Starting process X"的logToFile已经发生之前，lotsOfProcessing不应该发生。这意味着当用户tell我们某些东西时，我们不仅需要记住我们被告知的内容，还需要记住之后发生的一切。我们"记住"构造函数中的东西以data.

data LoggerT w m a
    = Tell w (LoggerT w m a)
    | ...
tell :: w -> LoggerT w m ()
tell w = Tell w (return ())

我们还需要能够在底层Monad中执行操作。添加另一个构造函数Lift (m a)很诱人，但是我们无法决定要记录什么作为底层计算的结果。相反，我们将让它决定整个未来LoggerT w m a运行。

data LoggerT w m a
    = Tell w    (LoggerT w m a)
    | M      (m (LoggerT w m a))
    ...

如果我们试图将底层计算m a lift LoggerT我们现在就遇到了问题;我们没有办法将a变成LoggerT w m a，以将其放入M构造函数中。

instance MonadTrans (LoggerT w m) where
    lift ma = M (??? ma)

我们可以尝试从底层Monad lift return，但这只是一个循环定义。我们将添加另一个用于Return的构造函数。

data LoggerT w m a
    = Tell   w    (LoggerT w m a)
    | M        (m (LoggerT w m a))
    | Return    a
instance MonadTrans (LoggerT w m) where
    lift = M . liftM Return

为了完成我们的 monad 转换器，我们将编写一个Monad实例。

instance Monad m => Monad (LoggerT w m) where
    return = Return
    la0 >>= k = go la0
         where
             go (Tell w la ) = Tell w (go la)
             go (M      mla) = M      (liftM go mla)
             go (Return a  ) = Return a

我们现在可以定义logTells .它将每个Tell替换为要执行的操作以记录它。

logTells :: (w -> LoggerT w' m ()) -> LoggerT w m a -> LoggerT w' m a
logTells k = go
    where
        go (Tell w la ) = k w >> go la
        go (M      mla) = M      (liftM go mla)
        go (Return a)   = return a

最后，我们将提供一种摆脱LoggerT的方法，将所有Tell替换为一个操作，与logTells非常相似，但从结果中删除LoggerT。由于它将摆脱LoggerT因此我们将其称为runLoggerT并交换参数以匹配其他转换器的约定。

runLoggerT :: LoggerT w m a -> (w -> m ()) -> m a
runLoggerT la0 k = go la0
    where
        go (Tell w la ) = k w >> go la
        go (M      mla) =        liftM go mla
        go (Return a)   =        return a

LoggerT已经存在，我们不需要自己写。这是来自非常成熟的管道库的Producer。

管道

管道库中的Producer是正确的测井转换器。

type Producer b = Proxy X () () b

每个Proxy都有一个MonadTrans (Proxy a' a b' b)实例和一个Monad m => Monad (Proxy a' a b' b m)实例。

我们tell它 用什么记录 yield .

yield :: Monad m => a -> Producer' a m ()
tell = yield                             

当我们知道我们想用 yield s 做什么时，我们会用我们想做的事情替换它们 for .

for :: Monad m =>
             Proxy x' x b' b m a' ->
       (b -> Proxy x' x c' c m b')   
          -> Proxy x' x c' c m a'

专门用于Producer和()，for具有

for :: Monad m => 
             Producer b m a   ->
       (b -> Producer c m ()) ->
             Producer c m a
logTells = flip for

如果我们用底层 monad 中的一个操作替换每个yield，我们将不再产生任何内容，并且可以使用 runEffect 运行Proxy。

runEffect :: Monad m => Effect             m r -> m r
runEffect :: Monad m => Proxy    X () () X m r -> m r
runEffect :: Monad m => Producer         X m r -> m r
runLoggerT la0 k = runEffect $ for la0 (lift . k)

我们甚至可以用替换底层 monad 的 hoist 来恢复WriterT(每个Proxy a' a b' b都有一个MFunctor实例(。

hoist :: (Monad m, MFunctor t) => (forall a. m a -> n a) -> t m b -> t n b 

我们使用hoist通过将每个m a lift到WriterT w m a中，将底层 monad 替换为 WriterT w m 。然后我们用 lift . tell 替换每个yield，并运行结果。

toWriterT :: (Monad m, Monoid w) => Producer w m r -> WriterT w m r
toWriterT p0 = runEffect $ for (hoist lift p0) (lift . tell)
toWriterT p0 = runLoggerT      (hoist lift p0)         tell

Producer本质上是不需要对正在写入的项目进行Monoid的免费WriterT。

Answer 3

这是一个简化但绝对现实生活中的示例，它使用 censor(根据pass定义为

censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
censor f m = pass $ (,f) <$> m

( 收集 lambda 项的自由变量：

import Control.Monad.Writer
import Data.Set (Set)
import qualified Data.Set as Set
type VarId = String
data Term = Var VarId
          | Lam VarId Term
          | App Term Term
freeVars :: Term -> Set VarId
freeVars = execWriter . go
  where
    go :: Term -> Writer (Set VarId) ()
    go (Var x) = tell $ Set.singleton x
    go (App f e) = go f >> go e
    go (Lam x e) = censor (Set.delete x) $ go e

现在，当然你可以在没有所有Writer机制的情况下实现这一点，但请记住，这只是一个简化的例子，代表一些更复杂的编译/分析功能，其中跟踪自由变量只是正在发生的事情之一。

Answer 4

文档是否足够清晰？ http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Writer-Lazy.html#g:1

示例(在 ghci 中运行以下命令(

import Control.Monad.Writer
runWriterT ( do (a,w) <- listen $ do { tell "foo" ; return 42 } ; tell $ reverse w ; return a )
    ==> (42,"foooof")
runWriterT ( pass $ do { tell "foo" ; return (42,reverse) } )
    ==> (42,"oof")