hexpat 0.4 → 0.5

raw patch · 13 files changed

+545/−273 lines, 13 filesdep +containersdep +extensible-exceptionsPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, extensible-exceptions

API changes (from Hackage documentation)

Files

• Text/XML/Expat/Format.hs +36/−22
• Text/XML/Expat/Namespaced.hs +150/−0
• Text/XML/Expat/Qualified.hs +47/−71
• Text/XML/Expat/Tree.hs +182/−81
• hexpat.cabal +19/−14
• test/benchmark.hs +18/−13
• test/errorHandlingWay1.hs +12/−0
• test/errorHandlingWay2.hs +16/−0
• test/lazySAX.hs +1/−1
• test/lazyTree.hs +1/−1
• test/lazyTreeThrow.hs +28/−0
• test/perf.hs +0/−42
• test/tests.hs +35/−28

@@ -9,7 +9,9 @@  module Text.XML.Expat.Format (         formatTree,+        formatTree',         formatNode,+        formatNode',         putTree,         putNode     ) where@@ -24,53 +26,65 @@ import Data.Binary.Put import Control.Monad --- | Format document with <?xml.. header.-formatTree :: TreeFlavor tag text-           -> Node tag text+-- | Format document with <?xml.. header - lazy variant that returns lazy ByteString.+formatTree :: (GenericXMLString tag, GenericXMLString text) =>+              Node tag text            -> L.ByteString-formatTree flavour node = runPut $ putTree flavour node+formatTree node = runPut $ putTree node --- | Format XML node with no header.-formatNode :: TreeFlavor tag text-           -> Node tag text+-- | Format document with <?xml.. header - strict variant that returns strict ByteString.+formatTree' :: (GenericXMLString tag, GenericXMLString text) =>+               Node tag text+            -> B.ByteString+formatTree' node = B.concat $ L.toChunks $ runPut $ putTree node++-- | Format XML node with no header - lazy variant that returns lazy ByteString.+formatNode :: (GenericXMLString tag, GenericXMLString text) =>+              Node tag text            -> L.ByteString-formatNode flavour node = runPut $ putNode flavour node+formatNode node = runPut $ putNode node +-- | Format XML node with no header - strict variant that returns strict ByteString.+formatNode' :: (GenericXMLString tag, GenericXMLString text) =>+               Node tag text+            -> B.ByteString+formatNode' node = B.concat $ L.toChunks $ runPut $ putNode node+ -- | 'Data.Binary.Put.Put' interface for formatting a tree with <?xml.. header.-putTree :: TreeFlavor tag text-        -> Node tag text+putTree :: (GenericXMLString tag, GenericXMLString text) =>+           Node tag text         -> Put-putTree flavour node = do+putTree node = do     putByteString $ pack "<?xml version=\"1.0\""     putByteString $ pack " encoding=\"UTF-8\""     putByteString $ pack "?>\n"-    putNode flavour node+    putNode node  -- | 'Data.Binary.Put.Put' interface for formatting a node with no header.-putNode :: TreeFlavor tag text-           -> Node tag text-           -> Put-putNode flavour@(TreeFlavor _ _ putTag fmtText) (Element name attrs children) = do+putNode :: (GenericXMLString tag, GenericXMLString text) =>+           Node tag text+        -> Put+putNode (Element name attrs children) = do     putWord8 $ c2w '<'-    let putThisTag = putTag name+    let putThisTag = putByteString $ gxToByteString name     putThisTag     forM_ attrs $ \(aname, avalue) -> do         putWord8 $ c2w ' '-        putTag aname+        putByteString $ gxToByteString aname         putByteString $ pack "=\""-        putXMLText $ fmtText avalue+        putXMLText $ gxToByteString avalue         putByteString $ pack "\""      if null children         then             putByteString $ pack "/>"         else do             putWord8 $ c2w '>'-            forM_ children $ putNode flavour+            forM_ children putNode             putByteString $ pack "</"             putThisTag             putWord8 $ c2w '>'-putNode (TreeFlavor _ _ putTag fmtText) (Text txt) =-    putXMLText $ fmtText txt+putNode (Text txt) =+    putXMLText $ gxToByteString txt  pack :: String -> B.ByteString pack = B.pack . map c2w

@@ -0,0 +1,150 @@+module Text.XML.Expat.Namespaced+      ( NName (..)+      , NNode+      , NNodes+      , NAttributes+      , mkNName+      , mkAnNName+      , toNamespaced+      , fromNamespaced+      , xmlnsUri+      , xmlns+      ) where++import Text.XML.Expat.Tree+import Text.XML.Expat.Qualified+import Control.Parallel.Strategies+import qualified Data.Map as M+import qualified Data.Maybe as DM+import qualified Data.List as L++-- | A namespace-qualified tag.+--+-- NName has two components, a local part and an optional namespace. The local part is the+-- name of the tag. The namespace is the URI identifying collections of declared tags.+-- Tags with the same local part but from different namespaces are distinct. Unqualified tags+-- are those with no namespace. They are in the default namespace, and all uses of an+-- unqualified tag are equivalent.+data NName text =+    NName {+        nnNamespace :: Maybe text,+        nnLocalPart :: !text+    }+    deriving (Eq,Show)++instance NFData text => NFData (NName text) where+    rnf (NName ns loc) = rnf (ns, loc)++-- | Type shortcut for nodes where namespaced names are used for tags+type NNodes text = Nodes (NName text) text++-- | Type shortcut for a single node where namespaced names are used for tags+type NNode text = Node (NName text) text++-- | Type shortcut for attributes where namespaced names are used for tags+type NAttributes text = Attributes (NName text) text++-- | Make a new NName from a prefix and localPart.+mkNName :: text -> text -> NName text+mkNName prefix localPart = NName (Just prefix) localPart++-- | Make a new NName with no prefix.+mkAnNName :: text -> NName text+mkAnNName localPart = NName Nothing localPart++type NsPrefixMap text = M.Map (Maybe text) (Maybe text)+type PrefixNsMap text = M.Map (Maybe text) (Maybe text)++xmlUri :: (GenericXMLString text) => text+xmlUri = gxFromString "http://www.w3.org/XML/1998/namespace"+xml :: (GenericXMLString text) => text+xml = gxFromString "xml"++xmlnsUri :: (GenericXMLString text) => text+xmlnsUri = gxFromString "http://www.w3.org/2000/xmlns/"+xmlns :: (GenericXMLString text) => text+xmlns = gxFromString "xmlns"++baseNsBindings :: (GenericXMLString text, Ord text)+               => NsPrefixMap text+baseNsBindings = M.fromList+  [ (Nothing, Nothing) +  , (Just xml, Just xmlUri)+  , (Just xmlns, Just xmlnsUri)+  ]++basePfBindings :: (GenericXMLString text, Ord text)+               => PrefixNsMap text+basePfBindings = M.fromList+   [ (Nothing, Nothing)+   , (Just xmlUri, Just xml)+   , (Just xmlnsUri, Just xmlns)+   ]++toNamespaced :: (GenericXMLString text, Ord text, Show text)+               => QNode text -> NNode text+toNamespaced = nodeWithNamespaces baseNsBindings++nodeWithNamespaces :: (GenericXMLString text, Ord text, Show text)+                   => NsPrefixMap text -> QNode text -> NNode text+nodeWithNamespaces _ (Text t) = Text t+nodeWithNamespaces bindings (Element qname qattrs qchildren) = Element nname nattrs nchildren+  where+    for = flip map+    (nsAtts, otherAtts) = L.partition ((== Just xmlns) . qnPrefix . fst) qattrs+    (dfAtt, normalAtts) = L.partition ((== QName Nothing xmlns) . fst) otherAtts+    nsMap  = M.fromList $ for nsAtts $ \((QName _ lp), uri) -> (Just lp, Just uri)+    dfMap  = M.fromList $ for dfAtt $ \q -> (Nothing, Just $ snd q)+    chldBs = M.unions [dfMap, nsMap, bindings]+    trans (QName pref qual) = case pref `M.lookup` chldBs of+      Nothing -> error +              $  "Namespace prefix referenced but never bound: '"+              ++ (show . DM.fromJust) pref+              ++ "'"+      Just mUri -> NName mUri qual+    transAt (qn, v) = (trans qn, v) ++    nname       = trans qname++    nNsAtts     = map transAt nsAtts+    nDfAtt      = map transAt dfAtt+    nNormalAtts = map transAt normalAtts+    nattrs      = concat [nNsAtts, nDfAtt, nNormalAtts]++    nchildren   = for qchildren $ nodeWithNamespaces chldBs++fromNamespaced :: (GenericXMLString text, Ord text) => NNode text -> QNode text+fromNamespaced = nodeWithQualifiers 1 basePfBindings++nodeWithQualifiers :: (GenericXMLString text, Ord text)+                   => Int -> PrefixNsMap text -> NNode text -> QNode text+nodeWithQualifiers _ _ (Text text) = Text text+nodeWithQualifiers cntr bindings (Element nname nattrs nchildren) = Element qname qattrs qchildren+  where+    for = flip map+    (nsAtts, otherAtts) = L.partition ((== Just xmlnsUri) . nnNamespace . fst) nattrs+    (dfAtt, normalAtts) = L.partition ((== NName Nothing xmlns) . fst) otherAtts+    nsMap = M.fromList $ for nsAtts $ \((NName _ lp), uri) -> (Just uri, Just lp)+    dfMap = M.fromList $ for dfAtt  $ \(_, uri) -> (Just uri, Just xmlns)+    chldBs = M.unions [dfMap, nsMap, bindings]++    trans (i, bs, as) (NName nspace qual) =+      case nspace `M.lookup` bs of+           Nothing -> let+                        pfx = gxFromString $ "ns" ++ show i+                        bs' = M.insert nspace (Just pfx) bs+                        as' = (NName (Just xmlnsUri) pfx, DM.fromJust nspace) : as+                      in trans (i+1, bs', as') (NName nspace qual)+           Just pfx -> ((i, bs, as), QName pfx qual)+    transAt ibs (nn, v) = let (ibs', qn) = trans ibs nn+                          in  (ibs', (qn, v))++    ((i', bs', as'), qname) = trans (cntr, chldBs, []) nname++    ((i'',   bs'',   as''),   qNsAtts)     = L.mapAccumL transAt (i',    bs',    as')    nsAtts+    ((i''',  bs''',  as'''),  qDfAtt)      = L.mapAccumL transAt (i'',   bs'',   as'')   dfAtt+    ((i'''', bs'''', as''''), qNormalAtts) = L.mapAccumL transAt (i''',  bs''',  as''')  normalAtts+    (_,                       qas)         = L.mapAccumL transAt (i'''', bs'''', as'''') as''''+    qattrs = concat [qNsAtts, qDfAtt, qNormalAtts, qas]++    qchildren = for nchildren $ nodeWithQualifiers i'''' bs''''

@@ -2,21 +2,22 @@ -- Copyright (C) 2008 Evan Martin <martine@danga.com> -- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam> --- | With the default flavors for 'Text.XML.Expat.Tree.parseTree' and--- 'Text.XML.Expat.Format.formatTree', qualified tag and attribute names such as+-- | In the default representation, qualified tag and attribute names such as -- \<abc:hello\> are represented just as a string containing a colon, e.g. -- \"abc:hello\". ----- This module provides flavors that handle these more intelligently, splitting+-- This module provides functionality to handle these more intelligently, splitting -- all tag and attribute names into their Prefix and LocalPart components.  module Text.XML.Expat.Qualified (         QName(..),+        QNode,+        QNodes,+        QAttributes,         mkQName,-        mkAnName,-        qualifiedStringFlavor,-        qualifiedByteStringFlavor,-        qualifiedTextFlavor+        mkAnQName,+        toQualified,+        fromQualified     ) where  import Text.XML.Expat.IO@@ -34,10 +35,15 @@ import Data.Monoid import Data.Binary.Put import qualified Codec.Binary.UTF8.String as U8-import Foreign.C.String-import Foreign.Ptr -+-- | A qualified name.+--+-- Qualified names have two parts, a prefix and a local part. The local part+-- is the name of the tag. The prefix scopes that name to a particular+-- group of legal tags.+--+-- The prefix will usually be associated with a namespace URI. This is usually+-- achieved by using xmlns attributes to bind prefixes to URIs. data QName text =     QName {         qnPrefix    :: Maybe text,@@ -48,77 +54,47 @@ instance NFData text => NFData (QName text) where     rnf (QName pre loc) = rnf (pre, loc) +-- | Type shortcut for nodes where qualified names are used for tags+type QNodes text = Nodes (QName text) text++-- | Type shortcut for a single node where qualified names are used for tags+type QNode text = Node (QName text) text++-- | Type shortcut for attributes where qualified names are used for tags+type QAttributes text = Attributes (QName text) text+ -- | Make a new QName from a prefix and localPart. mkQName :: text -> text -> QName text mkQName prefix localPart = QName (Just prefix) localPart  -- | Make a new QName with no prefix.-mkAnName :: text -> QName text-mkAnName localPart = QName Nothing localPart+mkAnQName :: text -> QName text+mkAnQName localPart = QName Nothing localPart --- | Flavor for qualified tags, using String data type.-qualifiedStringFlavor :: TreeFlavor (QName String) String-qualifiedStringFlavor = TreeFlavor (\t -> toQName <$> unpack t) unpackLen fromQName pack+toQualified :: (GenericXMLString text) => UNode text -> QNode text+toQualified (Text text) = Text text+toQualified (Element uname uatts uchldrn) = Element qname qatts qchldrn   where-    unpack    cstr = U8.decodeString <$> peekCString cstr-    unpackLen cstr = U8.decodeString <$> peekCStringLen cstr-    toQName ident =-        case break (== ':') ident of-            (prefix, ':':local) -> QName (Just prefix) local-            otherwise           -> QName Nothing ident-    pack = B.pack . map c2w . U8.encodeString-    fromQName (QName (Just prefix) local) = do-        mapM_ (putWord8 . c2w) prefix-        putWord8 $ c2w ':'-        mapM_ (putWord8 . c2w) local-    fromQName (QName Nothing local) = mapM_ (putWord8 . c2w) local+    qname   = qual uname+    qatts   = map (\(tag, text) -> (qual tag, text)) uatts+    qchldrn = map toQualified uchldrn --- | Flavor for qualified tags, using ByteString data type, containing UTF-8 encoded Unicode.-qualifiedByteStringFlavor :: TreeFlavor (QName B.ByteString) B.ByteString-qualifiedByteStringFlavor = TreeFlavor (\t -> toQName <$> unpack t) unpackLen fromQName id-  where-    unpack    cstr = peekByteString cstr-    unpackLen cstr = peekByteStringLen cstr-    toQName ident =-        case B.break (== c2w ':') ident of-            (prefix, _local) | not (B.null _local) && B.head _local == c2w ':' ->-                                   QName (Just prefix) (B.tail _local)-            otherwise           -> QName Nothing ident-    fromQName (QName (Just prefix) local) = do-        putByteString prefix-        putWord8 $ c2w ':'-        putByteString local-    fromQName (QName Nothing local) = putByteString local-    colon = B.singleton (c2w ':')+    qual ident =+        case gxBreakOn ':' ident of+             (prefix, _local) | not (gxNullString _local)+                              && gxHead _local == ':'+                                 -> QName (Just prefix) (gxTail _local)+             otherwise           -> QName Nothing ident --- | Flavor for qualified tags, using Text data type.-qualifiedTextFlavor :: TreeFlavor (QName T.Text) T.Text-qualifiedTextFlavor = TreeFlavor (\t -> toQName <$> unpack t) unpackLen fromQName TE.encodeUtf8+fromQualified :: (GenericXMLString text) => QNode text -> UNode text+fromQualified (Text text) = Text text+fromQualified (Element qname qatts qchldrn) = Element uname uatts uchldrn   where-    unpack    cstr = TE.decodeUtf8 <$> peekByteString cstr-    unpackLen cstr = TE.decodeUtf8 <$> peekByteStringLen cstr-    toQName ident =-        case T.break (== ':') ident of-            (prefix, _local) | not (T.null _local) && T.head _local == ':' ->-                                   QName (Just prefix) (T.tail _local)-            otherwise           -> QName Nothing ident-    fromQName (QName (Just prefix) local) = do-        putByteString . TE.encodeUtf8 $ prefix-        putWord8 $ c2w ':'-        putByteString . TE.encodeUtf8 $ local-    fromQName (QName Nothing local) = putByteString . TE.encodeUtf8 $ local-    colon = T.singleton ':'--peekByteString :: CString -> IO B.ByteString-{-# INLINE peekByteString #-}-peekByteString cstr = do-    len <- I.c_strlen cstr-    peekByteStringLen (castPtr cstr, fromIntegral len)+    uname   = tag qname+    uatts   = map (\(qual, text) -> (tag qual, text)) qatts+    uchldrn = map fromQualified qchldrn -peekByteStringLen :: CStringLen -> IO B.ByteString -{-# INLINE peekByteStringLen #-}-peekByteStringLen (cstr, len) =-    I.create (fromIntegral len) $ \ptr ->-        I.memcpy ptr (castPtr cstr) (fromIntegral len)+    tag (QName (Just prefix) local) = prefix `mappend` gxFromChar ':' `mappend` local+    tag (QName Nothing       local) = local  

@@ -1,3 +1,5 @@+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances #-}+ -- hexpat, a Haskell wrapper for expat -- Copyright (C) 2008 Evan Martin <martine@danga.com> -- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam>@@ -5,12 +7,54 @@ -- | This module provides functions to parse an XML document to a tree structure, -- either strictly or lazily, as well as a lazy SAX-style interface. ----- Extensible \"flavors\" give you the ability to use any string type. Three--- are provided here: String, ByteString and Text.+-- The GenericXMLString type class allows you to use any string type. Three+-- string types are provided for here: @String@, @ByteString@ and @Text@.+--+-- Error handling in strict parses is very straight forward - just check the+-- 'Either' return value.  Lazy parses are not so simple.  Here are two working+-- examples that illustrate the ways to handle errors.  Here they are:+--+-- Way no. 1+--+-- > import Text.XML.Expat.Tree+-- > import qualified Data.ByteString.Lazy as L+-- > import Data.ByteString.Internal (c2w)+-- > import Control.Exception.Extensible as E+-- > +-- > -- This is the recommended way to handle errors in lazy parses+-- > main = do+-- >     let (tree, mError) = parseTree Nothing (L.pack $ map c2w $ "<top><banana></apple></top>")+-- >     print (tree :: UNode String)+-- >     -- Note: We check the error _after_ we have finished our processing on the tree.+-- >     case mError of+-- >         Just err -> putStrLn $ "It failed : "++show err+-- >         Nothing -> putStrLn "Success!"+--+-- Way no. 2+--+-- > ...+-- > import Control.Exception.Extensible as E+-- > +-- > -- This is not the recommended way to handle errors.+-- > main = do+-- >     do+-- >         let tree = parseTreeThrowing Nothing (L.pack $ map c2w $ "<top><banana></apple></top>")+-- >         print (tree :: UNode String)+-- >         -- Because of lazy evaluation, you should not process the tree outside the 'do' block,+-- >         -- or exceptions could be thrown that won't get caught.+-- >     `E.catch` (\exc ->+-- >         case E.fromException exc of+-- >             Just (XMLParseException err) -> putStrLn $ "It failed : "++show err+-- >             Nothing -> E.throwIO exc)  module Text.XML.Expat.Tree (   -- * Tree structure   Node(..),+  Nodes,+  Attributes,+  UNode,+  UNodes,+  UAttributes,   -- * Parse to tree   parseTree,   parseTree',@@ -19,11 +63,13 @@   -- * SAX-style parse   parseSAX,   SAXEvent(..),-  -- * Flavors-  TreeFlavor(..),-  stringFlavor,-  byteStringFlavor,-  textFlavor+  saxToTree,+  -- * Variants that throw exceptions+  XMLParseException(..),+  parseSAXThrowing,+  parseTreeThrowing,+  -- * Abstraction of string types+  GenericXMLString(..) ) where  import Text.XML.Expat.IO@@ -33,10 +79,13 @@ import Data.IORef import System.IO.Unsafe (unsafePerformIO) import Data.ByteString.Internal (c2w, w2c, c_strlen)+import qualified Data.Monoid as M import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Codec.Binary.UTF8.String as U8 import Data.Binary.Put+import Data.Typeable+import Control.Exception.Extensible as Exc import Control.Applicative import Control.Concurrent import Control.Concurrent.MVar@@ -48,39 +97,53 @@ import Foreign.Ptr  -data TreeFlavor tag text = TreeFlavor-        (CString -> IO tag)-        (CStringLen -> IO text)-        (tag -> Put)-        (text -> B.ByteString)---- | Flavor for String data type.-stringFlavor :: TreeFlavor String String-stringFlavor = TreeFlavor unpack unpackLen (mapM_ (putWord8 . c2w)) pack-  where-    unpack    cstr = U8.decodeString <$> peekCString cstr-    unpackLen cstr = U8.decodeString <$> peekCStringLen cstr-    pack = B.pack . map c2w . U8.encodeString+-- | An abstraction for any string type you want to use as xml text (that is,+-- attribute values or element text content). If you want to use a+-- new string type with /hexpat/, you must make it an instance of+-- 'GenericXMLString'.+class (M.Monoid s, Eq s) => GenericXMLString s where+    gxNullString :: s -> Bool+    gxToString :: s -> String+    gxFromString :: String -> s+    gxFromChar :: Char -> s+    gxHead :: s -> Char+    gxTail :: s -> s+    gxBreakOn :: Char -> s -> (s, s)+    gxFromCStringLen :: CStringLen -> IO s+    gxToByteString :: s -> B.ByteString --- | Flavor for ByteString data type, containing UTF-8 encoded Unicode.-byteStringFlavor :: TreeFlavor B.ByteString B.ByteString-byteStringFlavor = TreeFlavor unpack unpackLen putByteString id-  where-    unpack    cstr = peekByteString cstr-    unpackLen cstr = peekByteStringLen cstr+instance GenericXMLString String where+    gxNullString = null+    gxToString = id+    gxFromString = id+    gxFromChar c = [c]+    gxHead = head+    gxTail = tail+    gxBreakOn c = break (==c)+    gxFromCStringLen cstr = U8.decodeString <$> peekCStringLen cstr+    gxToByteString = B.pack . map c2w . U8.encodeString --- | Flavor for Text data type.-textFlavor :: TreeFlavor T.Text T.Text-textFlavor = TreeFlavor unpack unpackLen (putByteString . TE.encodeUtf8) TE.encodeUtf8-  where-    unpack    cstr = TE.decodeUtf8 <$> peekByteString cstr-    unpackLen cstr = TE.decodeUtf8 <$> peekByteStringLen cstr+instance GenericXMLString B.ByteString where+    gxNullString = B.null+    gxToString = U8.decodeString . map w2c . B.unpack+    gxFromString = B.pack . map c2w . U8.encodeString+    gxFromChar = B.singleton . c2w+    gxHead = w2c . B.head+    gxTail = B.tail+    gxBreakOn c = B.break (== c2w c)+    gxFromCStringLen = peekByteStringLen+    gxToByteString = id -peekByteString :: CString -> IO B.ByteString-{-# INLINE peekByteString #-}-peekByteString cstr = do-    len <- I.c_strlen cstr-    peekByteStringLen (castPtr cstr, fromIntegral len)+instance GenericXMLString T.Text where+    gxNullString = T.null+    gxToString = T.unpack+    gxFromString = T.pack+    gxFromChar = T.singleton+    gxHead = T.head+    gxTail = T.tail+    gxBreakOn c = T.break (==c)+    gxFromCStringLen cstr = TE.decodeUtf8 <$> peekByteStringLen cstr+    gxToByteString = TE.encodeUtf8  peekByteStringLen :: CStringLen -> IO B.ByteString  {-# INLINE peekByteStringLen #-}@@ -88,6 +151,7 @@     I.create (fromIntegral len) $ \ptr ->         I.memcpy ptr (castPtr cstr) (fromIntegral len) + -- | The tree representation of the XML document. data Node tag text =     Element {@@ -102,44 +166,60 @@     rnf (Element nam att chi) = rnf (nam, att, chi)     rnf (Text txt) = rnf txt +-- | Type shortcut for attributes+type Attributes tag text = [(tag, text)]++-- | Type shortcut for nodes+type Nodes tag text = [Node tag text]++-- | Type shortcut for nodes with unqualified tag names where tag and+-- text are the same string type.+type UNodes text = Nodes text text++-- | Type shortcut for a single node with unqualified tag names where tag and+-- text are the same string type.+type UNode text = Node text text++-- | Type shortcut for attributes with unqualified tag names where tag and+-- text are the same string type.+type UAttributes text = Attributes text text+ modifyChildren :: ([Node tag text] -> [Node tag text])                -> Node tag text                -> Node tag text modifyChildren f node = node { eChildren = f (eChildren node) } +mkText :: GenericXMLString text => CString -> IO text+{-# INLINE mkText #-}+mkText cstr = do+    len <- c_strlen cstr+    gxFromCStringLen (cstr, fromIntegral len)+ -- | Strictly parse XML to tree. Returns error message or valid parsed tree.-parseTree' :: TreeFlavor tag text -- ^ Flavor, which determines the string type to use in the output-           -> Maybe Encoding      -- ^ Optional encoding override-           -> B.ByteString        -- ^ Input text (a lazy ByteString)+parseTree' :: (GenericXMLString tag, GenericXMLString text) =>+              Maybe Encoding      -- ^ Optional encoding override+           -> B.ByteString        -- ^ Input text (a strict ByteString)            -> Either XMLParseError (Node tag text)-{-# SPECIALIZE parseTree' :: TreeFlavor String String -> Maybe Encoding-          -> B.ByteString -> Either XMLParseError (Node String String) #-}-{-# SPECIALIZE parseTree' :: TreeFlavor B.ByteString B.ByteString -> Maybe Encoding-          -> B.ByteString -> Either XMLParseError (Node B.ByteString B.ByteString) #-}-{-# SPECIALIZE parseTree' :: TreeFlavor T.Text T.Text -> Maybe Encoding-          -> B.ByteString -> Either XMLParseError (Node T.Text T.Text) #-}-parseTree' (TreeFlavor mkTag mkText _ _) enc doc = unsafePerformIO $ runParse where+parseTree' enc doc = unsafePerformIO $ runParse where   runParse = do     parser <- newParser enc     -- We maintain the invariant that the stack always has one element,     -- whose only child at the end of parsing is the root of the actual tree.-    emptyString <- withCString "" mkTag +    let emptyString = gxFromString ""     stack <- newIORef [Element emptyString [] []]     setStartElementHandler parser $ \cName cAttrs -> do-        name <- mkTag cName+        name <- mkText cName         attrs <- forM cAttrs $ \(cAttrName,cAttrValue) -> do-            attrName <- mkTag cAttrName-            len <- c_strlen cAttrValue-            attrValue <- mkText (cAttrValue, fromIntegral len)+            attrName <- mkText cAttrName+            attrValue <- mkText cAttrValue             return (attrName, attrValue)         modifyIORef stack (start name attrs)         return True     setEndElementHandler parser $ \cName -> do-        name <- mkTag cName-        modifyIORef stack (end name)+        modifyIORef stack end         return True     setCharacterDataHandler parser $ \cText -> do-        txt <- mkText cText+        txt <- gxFromCStringLen cText         modifyIORef stack (text txt)         return True     mError <- parse parser doc@@ -151,7 +231,7 @@                start name attrs stack = Element name attrs [] : stack   text str (cur:rest) = modifyChildren (Text str:) cur : rest-  end name (cur:parent:rest) =+  end (cur:parent:rest) =     let node = modifyChildren reverse cur in     modifyChildren (node:) parent : rest @@ -170,28 +250,27 @@  -- | Lazily parse XML to SAX events. In the event of an error, FailDocument is -- the last element of the output list.-parseSAX :: TreeFlavor tag text -- ^ Flavor, which determines the string type to use in the output-         -> Maybe Encoding      -- ^ Optional encoding override+parseSAX :: (GenericXMLString tag, GenericXMLString text) =>+            Maybe Encoding      -- ^ Optional encoding override          -> L.ByteString        -- ^ Input text (a lazy ByteString)          -> [SAXEvent tag text]-parseSAX (TreeFlavor mkTag mkText _ _) enc input = unsafePerformIO $ do+parseSAX enc input = unsafePerformIO $ do     parser <- newParser enc     queueRef <- newIORef []     setStartElementHandler parser $ \cName cAttrs -> do-        name <- mkTag cName+        name <- mkText cName         attrs <- forM cAttrs $ \(cAttrName,cAttrValue) -> do-            attrName <- mkTag cAttrName-            len <- c_strlen cAttrValue-            attrValue <- mkText (cAttrValue, fromIntegral len)+            attrName <- mkText cAttrName+            attrValue <- mkText cAttrValue             return (attrName, attrValue)         modifyIORef queueRef (StartElement name attrs:)         return True     setEndElementHandler parser $ \cName -> do-        name <- mkTag cName+        name <- mkText cName         modifyIORef queueRef (EndElement name:)         return True     setCharacterDataHandler parser $ \cText -> do-        txt <- mkText cText+        txt <- gxFromCStringLen cText         modifyIORef queueRef (CharacterData txt:)         return True @@ -207,26 +286,32 @@      runParser $ L.toChunks input --- | Lazily parse XML to tree. Note that forcing the XMLParseError return value--- will force the entire parse.  Therefore, to ensure lazy operation, don't--- check the error status until you have processed the tree.-parseTree :: TreeFlavor tag text -- ^ Flavor, which determines the string type to use in the tree-          -> Maybe Encoding      -- ^ Optional encoding override-          -> L.ByteString        -- ^ Input text (a lazy ByteString)+-- | An exception indicating an XML parse error, used by the /..Throwing/ variants.+data XMLParseException = XMLParseException XMLParseError+    deriving (Eq, Show, Typeable)++instance Exception XMLParseException where++-- | Lazily parse XML to SAX events. In the event of an error, throw 'XMLParseException'.+parseSAXThrowing :: (GenericXMLString tag, GenericXMLString text) =>+                    Maybe Encoding      -- ^ Optional encoding override+                 -> L.ByteString        -- ^ Input text (a lazy ByteString)+                 -> [SAXEvent tag text]+parseSAXThrowing mEnc bs = map freakOut $ parseSAX mEnc bs+  where+    freakOut (FailDocument err) = Exc.throw $ XMLParseException err+    freakOut other = other++-- | A lower level function that lazily converts a SAX stream into a tree structure.+saxToTree :: GenericXMLString tag =>+             [SAXEvent tag text]           -> (Node tag text, Maybe XMLParseError)-{-# SPECIALIZE parseTree :: TreeFlavor String String -> Maybe Encoding-          -> L.ByteString -> (Node String String, Maybe XMLParseError) #-}-{-# SPECIALIZE parseTree :: TreeFlavor B.ByteString B.ByteString -> Maybe Encoding-          -> L.ByteString -> (Node B.ByteString B.ByteString, Maybe XMLParseError) #-}-{-# SPECIALIZE parseTree :: TreeFlavor T.Text T.Text -> Maybe Encoding-          -> L.ByteString -> (Node T.Text T.Text, Maybe XMLParseError) #-}-parseTree flavor@(TreeFlavor mkTag _ _ _) mEnc bs =-    let events = parseSAX flavor mEnc bs-        (nodes, mError, _) = ptl events+saxToTree events =+    let (nodes, mError, _) = ptl events     in  (safeHead nodes, mError)   where     safeHead (a:_) = a-    safeHead [] = Element (unsafePerformIO $ withCString "" mkTag) [] []+    safeHead [] = Element (gxFromString "") [] []     ptl (StartElement name attrs:rem) =         let (children, err1, rem') = ptl rem             elt = Element name attrs children@@ -238,4 +323,20 @@         in  (Text txt:out, err, rem')     ptl (FailDocument err:_) = ([], Just err, [])     ptl [] = ([], Nothing, [])++-- | Lazily parse XML to tree. Note that forcing the XMLParseError return value+-- will force the entire parse.  Therefore, to ensure lazy operation, don't+-- check the error status until you have processed the tree.+parseTree :: (GenericXMLString tag, GenericXMLString text) =>+             Maybe Encoding      -- ^ Optional encoding override+          -> L.ByteString        -- ^ Input text (a lazy ByteString)+          -> (Node tag text, Maybe XMLParseError)+parseTree mEnc bs = saxToTree $ parseSAX mEnc bs++-- | Lazily parse XML to tree. In the event of an error, throw 'XMLParseException'.+parseTreeThrowing :: (GenericXMLString tag, GenericXMLString text) =>+             Maybe Encoding      -- ^ Optional encoding override+          -> L.ByteString        -- ^ Input text (a lazy ByteString)+          -> Node tag text+parseTreeThrowing mEnc bs = fst $ saxToTree $ parseSAXThrowing mEnc bs 

@@ -1,28 +1,28 @@ Cabal-Version: >= 1.2 Name: hexpat-Version: 0.4+Version: 0.5 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser   written in C.   .-  This package provides a Haskell binding for Expat, with a choice of tree or-  SAX-style representation, and it includes an XML formatter.  It is extensible-  to any string type, with String, ByteString and Text provided out of the box.+  This package provides a Haskell binding for Expat, with a choice of /tree/ or+  /SAX-style/ representation, and it includes an /XML formatter/.  It is extensible+  to any string type, with @String@, @ByteString@ and @Text@ provided out of the box.   .   The emphasis is on speed and simplicity. If you want more complete and powerful-  XML libraries, consider using HaXml or HXT instead.+  XML libraries, consider using /HaXml/ or /HXT/ instead.   .-  Note that hexpat has undergone a major API change since 0.3.x.+  Note that /hexpat/ has undergone a major API change since 0.3.x.   .   Benchmark results on ghc 6.10.1 against HaXml for parsing a 4K xml file with non-threading runtime:-  HAXML: 2683 us, HEXPAT: low-level parse-no tree: 243 us, lazy-String: 1340 us,-  lazy-Text: 814 us, strict-String: 1194 us, strict-Text: 732 us+  HAXML: 2631 us, HEXPAT: low-level parse-no tree: 243 us, lazy-String: 1240 us,+  lazy-Text: 782 us, strict-String: 1125 us, strict-Text: 770 us   .   With -threaded:-  HAXML: 2691 us, HEXPAT: low-level parse-no tree: 472 us,-  lazy-String: 1575 us, lazy-Text: 1068 us, strict-String: 1396 us,-  strict-Text: 964 us+  HAXML: 2667 us, HEXPAT: low-level parse-no tree: 472 us,+  lazy-String: 1453 us, lazy-Text: 1057 us, strict-String: 1342 us,+  strict-Text: 943 us Category: XML License: BSD3 License-File: LICENSE@@ -35,11 +35,13 @@ Homepage: http://code.haskell.org/hexpat/ Extra-Source-Files:   test/tests.hs,-  test/perf.hs,   test/test.xml,   test/benchmark.hs,   test/lazySAX.hs,-  test/lazyTree.hs+  test/lazyTree.hs,+  test/lazyTreeThrow.hs,+  test/errorHandlingWay1.hs,+  test/errorHandlingWay2.hs Build-Type: Simple Stability: beta @@ -52,10 +54,13 @@     text >= 0.1,     binary >= 0.4,     utf8-string >= 0.3.3,-    parallel+    parallel,+    containers,+    extensible-exceptions >= 0.1 && < 0.2   Exposed-Modules:     Text.XML.Expat.Tree,     Text.XML.Expat.Format,+    Text.XML.Expat.Namespaced,     Text.XML.Expat.Qualified,     Text.XML.Expat.IO   Extensions: ForeignFunctionInterface

@@ -46,24 +46,29 @@     parse parser xml     return () -myParseTree flavor enc xml = parseTree flavor enc (L.fromChunks [xml])+myParseTree enc xml = parseTree enc (L.fromChunks [xml]) +fromRight :: Either XMLParseError a -> a+fromRight x = case x of+    Right right -> right+    Left err -> error (show err)+ tests :: [(String, B.ByteString -> String -> IO ())] tests = [     ("HaXml", \_ xml -> rnf (HaXml.xmlParse "input" xml) `seq` return ()),     ("low-level parse only, no tree", parseOnly),-    ("lazy myParseTree stringFlavor", \xml _ -> rnf (myParseTree stringFlavor Nothing xml) `seq` return ()),-    ("lazy myParseTree byteStringFlavor", \xml _ -> rnf (myParseTree byteStringFlavor Nothing xml) `seq` return ()),-    ("lazy myParseTree textFlavor", \xml _ -> rnf (myParseTree textFlavor Nothing xml) `seq` return ()),-    ("lazy myParseTree qualifiedStringFlavor", \xml _ -> rnf (myParseTree qualifiedStringFlavor Nothing xml) `seq` return ()),-    ("lazy myParseTree qualifiedByteStringFlavor", \xml _ -> rnf (myParseTree qualifiedByteStringFlavor Nothing xml) `seq` return ()),-    ("lazy myParseTree qualifiedTextFlavor", \xml _ -> rnf (myParseTree qualifiedTextFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' stringFlavor", \xml _ -> rnf (parseTree' stringFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' byteStringFlavor", \xml _ -> rnf (parseTree' byteStringFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' textFlavor", \xml _ -> rnf (parseTree' textFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' qualifiedStringFlavor", \xml _ -> rnf (parseTree' qualifiedStringFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' qualifiedByteStringFlavor", \xml _ -> rnf (parseTree' qualifiedByteStringFlavor Nothing xml) `seq` return ()),-    ("strict parseTree' qualifiedTextFlavor", \xml _ -> rnf (parseTree' qualifiedTextFlavor Nothing xml) `seq` return ())+    ("lazy parseTree string", \xml _ -> rnf (fst $ myParseTree Nothing xml :: UNode String) `seq` return ()),+    ("lazy parseTree byteString", \xml _ -> rnf (fst $ myParseTree Nothing xml :: UNode B.ByteString) `seq` return ()),+    ("lazy parseTree text", \xml _ -> rnf (fst $ myParseTree Nothing xml :: UNode T.Text) `seq` return ()),+    ("lazy parseTree qualifiedString", \xml _ -> rnf (toQualified $ fst $ myParseTree Nothing xml :: QNode String) `seq` return ()),+    ("lazy parseTree qualifiedByteString", \xml _ -> rnf (toQualified $ fst $ myParseTree Nothing xml :: QNode B.ByteString) `seq` return ()),+    ("lazy parseTree qualifiedText", \xml _ -> (toQualified $ fst $ myParseTree Nothing xml :: QNode T.Text) `seq` return ()),+    ("strict parseTree' string", \xml _ -> rnf (fromRight $ parseTree' Nothing xml :: UNode String) `seq` return ()),+    ("strict parseTree' byteString", \xml _ -> rnf (fromRight $ parseTree' Nothing xml :: UNode B.ByteString) `seq` return ()),+    ("strict parseTree' text", \xml _ -> rnf (fromRight $ parseTree' Nothing xml :: UNode T.Text) `seq` return ()),+    ("strict parseTree' qualifiedString", \xml _ -> rnf (toQualified $ fromRight $ parseTree' Nothing xml :: QNode String) `seq` return ()),+    ("strict parseTree' qualifiedByteString", \xml _ -> rnf (toQualified $ fromRight $ parseTree' Nothing xml :: QNode B.ByteString) `seq` return ()),+    ("strict parseTree' qualifiedText", \xml _ -> rnf (toQualified $ fromRight $ parseTree' Nothing xml :: QNode T.Text) `seq` return ())   ]  myCopy :: B.ByteString -> IO B.ByteString

@@ -0,0 +1,12 @@+import Text.XML.Expat.Tree+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Internal (c2w)++-- This is the recommended way to handle errors in lazy parses+main = do+    let (tree, mError) = parseTree Nothing (L.pack $ map c2w $ "<top><banana></apple></top>")+    print (tree :: UNode String)+    -- Note: We check the error _after_ we have finished our processing on the tree.+    case mError of+        Just err -> putStrLn $ "It failed : "++show err+        Nothing -> putStrLn "Success!"

@@ -0,0 +1,16 @@+import Text.XML.Expat.Tree+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Internal (c2w)+import Control.Exception.Extensible as E++-- This is not the recommended way to handle errors. See errorHandlingWay1.hs+main = do+    do+        let tree = parseTreeThrowing Nothing (L.pack $ map c2w $ "<top><banana></apple></top>")+        print (tree :: UNode String)+        -- Because of lazy evaluation, you should not process the tree outside the 'do' block,+        -- or exceptions could be thrown that won't get caught.+    `E.catch` (\exc ->+        case E.fromException exc of+            Just (XMLParseException err) -> putStrLn $ "It failed : "++show err+            Nothing -> E.throwIO exc)

@@ -21,5 +21,5 @@ infiniteBL = toBL infiniteDoc  main = do-    mapM_ print $ parseSAX byteStringFlavor Nothing infiniteBL+    mapM_ print (parseSAX Nothing infiniteBL :: [SAXEvent B.ByteString B.ByteString]) 

@@ -21,5 +21,5 @@ infiniteBL = toBL infiniteDoc  main = do-    print $ fst $ parseTree stringFlavor Nothing infiniteBL+    print (fst $ parseTree Nothing infiniteBL :: UNode B.ByteString) 

@@ -0,0 +1,28 @@+module Main where++import Text.XML.Expat.Tree+import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)+import qualified Data.ByteString.Lazy as L+import Control.Monad++infiniteDoc = "<?xml version=\"1.0\"?><infinite>"++body 1+    where+        body i | i == 5000 = "</bad-xml>" ++ body (i+1)+        body i = "\n  <item idx=\"" ++ show i ++ "\"/>"++body (i+1)++toBL :: String -> L.ByteString+toBL = L.fromChunks . chunkify+  where+    chunkify [] = []+    chunkify str =+        let (start, rem) = splitAt 1024 str+        in  (B.pack $ map c2w start):chunkify rem++infiniteBL = toBL infiniteDoc++-- This test passes if it raises an exception when it gets bad XML.++main = do+    print $ (parseTreeThrowing Nothing infiniteBL :: UNode B.ByteString)+

@@ -1,42 +0,0 @@--- hexpat, a Haskell wrapper for expat--- Copyright (C) 2008 Evan Martin <martine@danga.com>---- This program microbenchmarks HaXml versus Expat parsing.--- The comparision is pretty unfair; HaXml does a whole lot more.--- However, if you just want to read all the XML tags in a file,--- this program demonstrates why Expat may be preferable.--import Control.Exception-import qualified Data.ByteString.Lazy as BS-import Data.Char (ord)-import Data.IORef-import Microbench-import Text.XML.Expat.IO as Expat-import Text.XML.HaXml as HaXml--parse_haxml :: String -> IO ()-parse_haxml input = do-  let Document _ _ root _ = HaXml.xmlParse "input" input-  let Elem _ _ content = root-  evaluate $ length content-  return ()--parse_expat :: BS.ByteString -> IO ()-parse_expat input = do-  parser <- Expat.newParser Nothing-  counter <- newIORef 0-  Expat.setStartElementHandler parser (elementHandler counter)-  Expat.parse parser input-  readIORef counter-  return ()-  where-  elementHandler counter tag attrs = modifyIORef counter (+1)--main = do-  xml <- readFile "test.xml"-  let xmlbs = BS.pack (map (fromIntegral.ord) xml)-  -- Force reading the entire file first.-  putStrLn $ "input is " ++ show (BS.length xmlbs) ++ " bytes."-  -- Start the races.-  microbench "HaXml" (parse_haxml xml)-  microbench "hexpat" (parse_expat xmlbs)

@@ -1,8 +1,9 @@ import Text.XML.Expat.Tree import Text.XML.Expat.Format import Text.XML.Expat.Qualified-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T import Data.ByteString.Internal (c2w, w2c) import Data.Char import Data.Maybe@@ -12,21 +13,21 @@ import Test.HUnit hiding (Node) import System.IO -toByteStringL :: String -> BSL.ByteString-toByteStringL = BSL.pack . map c2w+toByteStringL :: String -> L.ByteString+toByteStringL = L.pack . map c2w -fromByteStringL :: BSL.ByteString -> String-fromByteStringL = map w2c . BSL.unpack+fromByteStringL :: L.ByteString -> String+fromByteStringL = map w2c . L.unpack -toByteString :: String -> BS.ByteString-toByteString = BS.pack . map c2w+toByteString :: String -> B.ByteString+toByteString = B.pack . map c2w -fromByteString :: BS.ByteString -> String-fromByteString = map w2c . BS.unpack+fromByteString :: B.ByteString -> String+fromByteString = map w2c . B.unpack  testDoc :: (Show tag, Show text) =>            (Maybe Encoding -> bs -> Either XMLParseError (Node tag text))-        -> (Node tag text -> BSL.ByteString)+        -> (Node tag text -> L.ByteString)         -> (String -> bs)         -> String         -> Int@@ -60,7 +61,7 @@  test_error1 :: IO () test_error1 = do-    let eDoc = parseTree' stringFlavor Nothing (toByteString "<hello></goodbye>")+    let eDoc = parseTree' Nothing (toByteString "<hello></goodbye>") :: Either XMLParseError (UNode String)     assertEqual "error1" (Left $ XMLParseError "mismatched tag" 1 9) eDoc  test_error2 :: IO ()@@ -68,8 +69,8 @@     assertEqual "error2" (             Element {eName = "hello", eAttrs = [], eChildren = []},             Just (XMLParseError "mismatched tag" 1 9)-        ) $ parseTree stringFlavor Nothing-              (toByteStringL "<hello></goodbye>")+        ) (parseTree Nothing+              (toByteStringL "<hello></goodbye>") :: (UNode String, Maybe XMLParseError))  test_error3 :: IO () test_error3 =@@ -79,12 +80,12 @@                 Element {eName = "hello", eAttrs = [], eChildren = []}             ]},             Just (XMLParseError "mismatched tag" 1 35)-        ) $ parseTree stringFlavor Nothing+        ) $ parseTree Nothing               (toByteStringL "<open><test1>Hello</test1><hello></goodbye>")  test_error4 :: IO () test_error4 = do-    let eDoc = parseTree' stringFlavor Nothing (toByteString "!")+    let eDoc = parseTree' Nothing (toByteString "!") :: Either XMLParseError (UNode String)     assertEqual "error1" (Left $ XMLParseError "not well-formed (invalid token)" 1 0) eDoc  main = do@@ -99,18 +100,24 @@             forM_ (zip [1..] docs) $ \(idx, doc) ->                 testDoc parse fmt toByteString descr idx doc     runTestTT $ TestList [-        TestCase $ t' ("String", parseTree' stringFlavor, formatTree stringFlavor),-        TestCase $ t' ("ByteString", parseTree' byteStringFlavor, formatTree byteStringFlavor),-        TestCase $ t' ("Text", parseTree' textFlavor, formatTree textFlavor),-        TestCase $ t ("String/Lazy", eitherify $ parseTree stringFlavor, formatTree stringFlavor),-        TestCase $ t ("ByteString/Lazy", eitherify $ parseTree byteStringFlavor, formatTree byteStringFlavor),-        TestCase $ t ("Text/Lazy", eitherify $ parseTree textFlavor, formatTree textFlavor),-        TestCase $ t' ("String/Qualified", parseTree' qualifiedStringFlavor, formatTree qualifiedStringFlavor),-        TestCase $ t' ("ByteString/Qualified", parseTree' qualifiedByteStringFlavor, formatTree qualifiedByteStringFlavor),-        TestCase $ t' ("Text/Qualified", parseTree' qualifiedTextFlavor, formatTree qualifiedTextFlavor),-        TestCase $ t ("String/Qualified/Lazy", eitherify $ parseTree qualifiedStringFlavor, formatTree qualifiedStringFlavor),-        TestCase $ t ("ByteString/Qualified/Lazy", eitherify $ parseTree qualifiedByteStringFlavor, formatTree qualifiedByteStringFlavor),-        TestCase $ t ("Text/Qualified/Lazy", eitherify $ parseTree qualifiedTextFlavor, formatTree qualifiedTextFlavor),+        TestCase $ t' ("String",+            parseTree' :: Maybe Encoding -> B.ByteString -> Either XMLParseError (Node String String),+            formatTree),+        TestCase $ t' ("ByteString",+            parseTree' :: Maybe Encoding -> B.ByteString -> Either XMLParseError (Node B.ByteString B.ByteString),+            formatTree),+        TestCase $ t' ("Text",+            parseTree' :: Maybe Encoding -> B.ByteString -> Either XMLParseError (Node T.Text T.Text),+            formatTree),+        TestCase $ t ("String/Lazy",+            eitherify $ parseTree :: Maybe Encoding -> L.ByteString -> Either XMLParseError (Node String String),+            formatTree),+        TestCase $ t ("ByteString/Lazy",+            eitherify $ parseTree :: Maybe Encoding -> L.ByteString -> Either XMLParseError (Node B.ByteString B.ByteString),+            formatTree),+        TestCase $ t ("Text/Lazy",+            eitherify $ parseTree :: Maybe Encoding -> L.ByteString -> Either XMLParseError (Node T.Text T.Text),+            formatTree),         TestCase $ test_error1,         TestCase $ test_error2,         TestCase $ test_error3,