为什么runConduit不发送所有数据？为什么行为不如预期为什么它表现得如此如何实现预期的行为

问题描述

这是我正在解析的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中）），以及join和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","Daily Update")
("Weekly Report 10.14.2020","Weekly Report")
("Weekly Report 10.07.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，但它放弃了所有解析，而不仅仅是使当前解析失败。 / p>

此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“用于传递解析”？

解决方法

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

为什么行为不如预期

xml-conduit（尤其是围绕以下不变量设计的）：

当解析器的类型为ConduitT Event o m (Maybe a)时，Maybe层将编码Event是否已使用
tag' parseName parseAttributes parseContent仅在Event和parseName都成功的情况下消耗parseAttributes s
tag' parseName parseAttributes parseContent仅在parseContent和parseName都成功的情况下运行parseAttributes

在parseDoc中：

在check部分中调用parseContent函数；在这个阶段，tag'已经承诺要消耗Event，按照不变式2
将两叠Maybe层堆叠在一起join：
- check函数的输出，该函数编码当前<row/>元素是否相关
- 来自Maybe签名的“标准” tag'层，它根据不变式1编码Event是否已被消耗

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

为什么它表现得如此

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

尝试consumer
如果consumer返回Nothing，然后使用ignoreAnyTreeContent跳过元素或内容，假设consumer尚未使用元素或内容，然后递归回到步骤（1）

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

如何实现预期的行为

将check逻辑移至parseAttributes部分，以使Event的消耗与check是否通过有关。

applicative haskell haskell haskell-alternative xml-conduit xml-parsing