xml-conduit - 结合 tagParsers

xml-conduit - combining tagParsers

我一直在尝试用 xml-conduit 解析 XML-datastructure,经过一些学习后似乎可以工作。但我现在坚持的是以下内容。

给定标签解析器列表,我如何使用 choose 组合它们

data SumType = A Text | B Text | C Text

parseSumTypeList :: MonadThrow m => ConduitM Event o m (Maybe SumType)
parseSumTypeList = choose $ 
                   [ (tagIgnoreAttrs "A"
                     $ do result <- content
                          return (A $ result))
                   , (tagIgnoreAttrs "B"
                     $ do result <- content
                          return (A $ result))
                   , (tagIgnoreAttrs "C"
                     $ do result <- content
                          return (A $ result))]

虽然上述工作正常 - 如果我将通用模式重构为

parseSumTypeList :: MonadThrow m => ConduitM Event o m (Maybe SumType)
parseSumTypeList = choose $ map f [("A",A),("B",B),("C",C)]
                 where f (str,constr) = tagIgnoreAttrs str
                                      $ do result <- content
                                           return (constr $ result)

我收到以下错误

Couldn't match type ‘ConduitM Event o0 m0 (Maybe SumType)’
               with ‘forall o1. ConduitM Event o1 m (Maybe SumType)’
Expected type: (Name, Text -> SumType)
               -> Consumer Event m (Maybe SumType)
  Actual type: (Name, Text -> SumType)
               -> ConduitM Event o0 m0 (Maybe SumType)
Relevant bindings include
  parseSumType :: Consumer Event m (Maybe SumType)
    (bound at ...)
In the first argument of ‘map’, namely ‘f’
In the first argument of ‘choose’, namely
  ‘(map f [("A", A), ("B", B), ("C", C)])’

在我看来,forall o 部分变得专门化了 - 因此它不再是 forall,但这只是一个猜测。

来自 xml-conduit

的文档
choose :: Monad m    
        => [Consumer Event m (Maybe a)] -- List of parsers that will be tried in order.
        -> Consumer Event m (Maybe a) -- Result of the first parser to succeed, or Nothing if no parser succeeded

并且知道 Consumer 只是一个类型同义词

type Consumer i m r = forall o. ConduitM i o m r

编辑:

我尝试使用 f 作为 lambda 函数 - 但也没有用。

parseSumTypeList = choose $ flip map [("A",A),("B",B),("C",C)]
                                     $\(str,constr) -> tagIgnoreAttrs str
                                        $ do result <- content
                                             return (constr $ result)

编辑 2:

ConduitErr.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}

module ConduitErr where

import           Control.Monad.Trans.Resource (MonadThrow)
import           Text.XML.Stream.Parse
import           Data.Text (Text)
import           Data.XML.Types (Event)
import           Data.Conduit (ConduitM)
-- import           Control.Lens ((&),(.~))

data SumType = A Text | B Text | C Text

parseSumTypeList :: MonadThrow m => ConduitM Event o m (Maybe SumType)
parseSumTypeList = choose $
                   [ (tagIgnoreAttrs "A"
                        $ do result <- content
                             return (A $ result))
                   , (tagIgnoreAttrs "B"
                        $ do result <- content
                             return (B $ result))
                   , (tagIgnoreAttrs "C"
                        $ do result <- content
                             return (C $ result))]

parseSumTypeList' :: MonadThrow m => ConduitM Event o m (Maybe SumType)
parseSumTypeList' = choose $ map f [("A",A),("B",B),("C",C)]
                 where f (str,constr) = tagIgnoreAttrs str
                                      $ do result <- content
                                           return (constr $ result)

foo.cabal

[...]
  build-depends:       base >=4.8 && <4.9
               ,       conduit
               ,       resourcet
               ,       text
               ,       xml-conduit
               ,       xml-types
[...]

您不能使用 map,但您可以这样做:

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Trans.Resource
import Data.Conduit
import Data.Text (Text, unpack)
import Data.XML.Types
import Text.XML.Stream.Parse

data SumType = A Text | B Text | C Text

parseList :: MonadThrow m => ConduitM Event o m (Maybe SumType)
parseList = choose [ mkCond "A" A , mkCond "B" B , mkCond "C" C ]
  where
    mkCond x xc = tagIgnoreAttrs x (content >>= (return . xc))