为什么 runConduit 不发送所有数据？

Question

这是我正在解析的一些 xml：

<?xml version="1.0" encoding="utf-8"?>
<data>
<row ows_Document='Weekly Report 10.21.2020'
     ows_Category='Weekly Report'/>
<row ows_Document='Daily Update 10.20.2020'
     ows_Category='Daily Update'/>
<row ows_Document='Weekly Report 10.14.2020'
     ows_Category='Weekly Report'/>
<row ows_Document='Weekly Report 10.07.2020'
     ows_Category='Weekly Report'/>
<row ows_Document='Spanish: Reporte Semanal 07.10.2020' 
     ows_Category='Weekly Report'/>
</data>

我一直试图弄清楚如何让管道解析器拒绝记录，除非ows_Category 是Weekly Report 并且ows_Document 不包含Spanish。起初，我使用一个虚拟值（在下面的parseDoc' 中）在解析后将它们过滤掉，但后来我意识到我应该能够使用Maybe（在下面的其他相同的parseDoc 中）以及@987654334 @ 折叠我的Maybe 层与tag' 事件解析器使用的层，该解析器基于名称或属性匹配失败。它可以编译，但行为很奇怪，显然甚至没有尝试将某些元素发送到解析器！这怎么可能？

{-# LANGUAGE OverloadedStrings #-}

import           Conduit
import           Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L8
import           Data.Foldable
import           Data.String
import qualified Data.Text                  as T
import           Data.XML.Types
import           Text.XML.Stream.Parse

newtype Doc = Doc
  { name :: String
  } deriving (Show)

main :: IO ()
main = do
  r <- L8.readFile "oha.xml"

  let doc = Doc . T.unpack
      check (x,y) a b = if y == "Weekly Report" && not (T.isInfixOf "Spanish" x) then a else b

      t :: (MonadThrow m, MonadIO m) => ((T.Text, T.Text) -> ConduitT Event o m c)
                                     -> ConduitT Event o m (Maybe c)
      t f = tag' "row" ((,) <$> requireAttr "ows_Document" <*> requireAttr "ows_Category") $ \x -> do
        liftIO $ print x
        f x

      parseDoc, parseDoc' :: (MonadThrow m, MonadIO m) => ConduitT Event o m (Maybe Doc)
      parseDoc  = (join <$>) . t $ \z@(x,_) -> return $       check z (Just $ doc x)  Nothing -- this version doesn't get sent all of the data! why!?!?
      parseDoc' =              t $ \z@(x,_) -> return $ doc $ check z             x $ T.pack bad -- dummy value

      parseDocs :: (MonadThrow m, MonadIO m) => ConduitT Event o m (Maybe Doc)
                                             -> ConduitT Event o m [Doc]
      parseDocs = f tagNoAttr "data" . many'
      f g n = force (n <> " required") . g (fromString n)

      go p = runConduit $ parseLBS def r .| parseDocs p
      bad = "no good"

  traverse_ print =<<                              go parseDoc
  putStrLn ""
  traverse_ print =<< filter ((/= bad) . name) <$> go parseDoc'

输出——注意parseDoc 甚至没有发送一条记录（应该成功的记录，从 10.14 开始），而 parseDoc' 的行为与预期一样：

("Weekly Report 10.21.2020","Weekly Report")
("Daily Update 10.20.2020","Daily Update")
("Weekly Report 10.07.2020","Weekly Report")
("Spanish: Reporte Semanal 07.10.2020","Weekly Report")
Doc {name = "Weekly Report 10.21.2020"}
Doc {name = "Weekly Report 10.07.2020"}

("Weekly Report 10.21.2020","Weekly Report")
("Daily Update 10.20.2020","Daily Update")
("Weekly Report 10.14.2020","Weekly Report")
("Weekly Report 10.07.2020","Weekly Report")
("Spanish: Reporte Semanal 07.10.2020","Weekly Report")
Doc {name = "Weekly Report 10.21.2020"}
Doc {name = "Weekly Report 10.14.2020"}
Doc {name = "Weekly Report 10.07.2020"}

当我尝试通过删除与ows_Category 相关的所有内容来进一步简化时，突然parseDoc 工作正常，确定了这个想法的合理性？当我删除了与ows_Document 相关的所有内容时，问题仍然存在。

我怀疑我应该使用 requireAttrRaw 执行此操作，但我无法理解它并且找不到文档/示例。

这和Applicative 有关系吗——现在我想起来了，它不应该基于检查值而失败，对吧？

更新

我从作者那里找到了该库的早期版本的 answer，其中包括在类似情况下有趣的 force "fail msg" $ return Nothing，但它放弃了所有解析，而不是仅仅使当前解析失败。

这个comment 建议我需要抛出一个异常，在source 中，他们使用lift $ throwM $ XmlException "failed check" $ Just event 之类的东西，但就像force ... return Nothing 一样，这会杀死所有解析，而不仅仅是当前解析器。我也不知道如何获得event。

这里有一个合并的pull request 声称已经解决了这个问题，但它没有讨论如何使用它，只是它是“微不足道的”:)

回答

要明确回答：

  parseAttributes :: AttrParser (T.Text, T.Text)
  parseAttributes = do
    d <- requireAttr "ows_Document"
    c <- requireAttr "ows_Category"
    ignoreAttrs
    guard $ not (T.isInfixOf "Spanish" d) && c == "Weekly Report"
    return d

  parseDoc :: (MonadThrow m, MonadIO m) => ConduitT Event o m (Maybe Doc)
  parseDoc = tag' "row" parseAttributes $ return . doc

或者，因为在这种情况下可以独立检查属性值：

  parseAttributes = requireAttrRaw' "ows_Document" (not . T.isInfixOf "Spanish")
                 <* requireAttrRaw' "ows_Category" ("Weekly Report" ==)
                 <* ignoreAttrs
    where requireAttrRaw' n f = requireAttrRaw ("required attr value failed condition: " <> n) $ \(n',as) ->
            asum $ (\(ContentText a) -> guard (n' == fromString n && f a) *> pure a) <$> as

但后者留下了关于requireAttrRaw的这些问题：

• 如果我们负责验证Name，难道不需要知道命名空间吗？
• 为什么requireAttrRaw给我们发[Content]而不是两个Maybe Content，ContentText和ContentEntity各发一个？
• 我们应该如何处理ContentEntity“用于传递解析”？

Answer 1

tl;dr 在tag' "row" parseAttributes parseContent 中，check 函数属于parseAttributes，而不属于parseContent。

---

为什么它的行为不像预期的那样

xml-conduit（特别是）围绕以下不变量设计：

1. 当解析器的类型为 ConduitT Event o m (Maybe a) 时，Maybe 层会编码 Events 是否已被使用
2. 当且仅当 parseName 和 parseAttributes 都成功时，tag' parseName parseAttributes parseContent 消耗 Events
3. 当且仅当 parseName 和 parseAttributes 都成功时，tag' parseName parseAttributes parseContent 运行 parseContent

在parseDoc:

• check 函数在parseContent 部分中调用；在这个阶段，tag' 已经承诺消费Events，根据不变量 2
• 2 个Maybe 层的堆栈被join 编在一起：
  • check 函数的输出，编码当前<row/> 元素是否相关
  • tag' 签名中的“标准”Maybe 层，根据不变量 1 编码是否已使用 Events

这实质上打破了不变量 1：当check 返回Nothing 时，parseDoc 返回Nothing，尽管消耗了整个Events 的<row/> 元素。 这会导致 xml-conduit 的所有组合子的未定义行为，尤其是 many'（分析如下。）

---

为什么会有这样的行为

many' 组合器依赖于不变量 1 来完成它的工作。 定义为many' consumer = manyIgnore consumer ignoreAnyTreeContent，即：

1. 试试consumer
2. 如果consumer返回Nothing，则使用ignoreAnyTreeContent跳过元素或内容，假设它还没有被consumer消费，然后递归回到步骤（1）

在您的情况下，consumer 为 Daily Update 10.20.2020 项目返回 Nothing，即使已使用完整的 <row/> 元素。因此，ignoreAnyTreeContent 是作为跳过特定 <row/> 的一种方式运行的，但实际上最终会跳过下一个 (Weekly Report 10.14.2020)。

---

如何实现预期的行为

将check逻辑移动到parseAttributes部分，使Event消费与check是否通过耦合。