tagParsers组合

Question

我一直在尝试用xml-导管来解析xml数据结构，这似乎在学习了一段时间之后才开始工作。但我现在坚持的是以下几点。

给出一个标记解析器列表，如何使用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

并且知道消费者只是一个类型的同义词

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)

EDIT2：

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

Answer 1

您不能使用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))