hexpat 0.9 → 0.10

raw patch · 7 files changed

+245/−32 lines, 7 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• Text/XML/Expat/Annotated.hs +193/−0
• Text/XML/Expat/Format.hs +1/−3
• Text/XML/Expat/IO.hs +9/−7
• Text/XML/Expat/Qualified.hs +0/−1
• Text/XML/Expat/Tree.hs +35/−14
• hexpat.cabal +3/−3
• test/tests.hs +4/−4

@@ -0,0 +1,193 @@+-- | A variant of /Node/ in which Element nodes have an annotation of any type,+-- and some concrete functions that annotate with the XML parse location.+-- It is assumed you will usually want /Tree/ or /Annotated/, not both, so many+-- of the names conflict.+--+-- Support for qualified and namespaced trees annotated with location information+-- is not complete.+module Text.XML.Expat.Annotated (+        -- * Tree structure+        Node(..),+        Attributes,  -- re-export from Tree+        Nodes,+        UNode,+        UNodes,+        UAttributes,+        LNode,+        LNodes,+        ULNode,+        ULNodes,+        textContent,+        unannotate,+        -- * Qualified nodes+        QName(..),+        QNode,+        QNodes,+        QAttributes,+        QLNode,+        QLNodes,+        -- * Namespaced nodes+        NName (..),+        NNode,+        NNodes,+        NAttributes,+        NLNode,+        NLNodes,+        mkNName,+        mkAnNName,+        xmlnsUri,+        xmlns,+        -- * Parse to tree+        parseTree,+        parseTree',+        Encoding(..),+        XMLParseError(..),+        XMLParseLocation(..),+        -- * SAX-style parse+        parseSAX,+        SAXEvent(..),+        saxToTree,+        parseSAXLocations,+        -- * Variants that throw exceptions+        XMLParseException(..),+        parseTreeThrowing,+        parseSAXThrowing,+        parseSAXLocationsThrowing,+        -- * Abstraction of string types+        GenericXMLString(..)+    ) where++import Text.XML.Expat.Tree hiding (Node(..), Nodes, UNode, UNodes, saxToTree,+    parseTree, parseTree', parseTreeThrowing, textContent)+import qualified Text.XML.Expat.Tree as Tree (Node(..))+import Text.XML.Expat.Qualified hiding (QNode, QNodes)+import Text.XML.Expat.Namespaced hiding (NNode, NNodes)++import Control.Monad (mplus)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Monoid+++-- | Annotated variant of the tree representation of the XML document.+data Node tag text a =+    Element {+        eName     :: !tag,+        eAttrs    :: ![(tag,text)],+        eChildren :: [Node tag text a],+        eAnn      :: a+    } |+    Text !text+    deriving (Eq, Show)++unannotate :: Node tag text a -> Tree.Node tag text+unannotate (Element na at ch _) = (Tree.Element na at (map unannotate ch))+unannotate (Text t) = Tree.Text t++-- | Extract all text content from inside a tag into a single string, including+-- any text contained in children.+textContent :: Monoid text => Node tag text a -> text+textContent (Element _ _ children _) = mconcat $ map textContent children+textContent (Text txt) = txt++-- | Type shortcut for annotated nodes+type Nodes tag text a = [Node tag text a]++-- | Type shortcut for annotated nodes with unqualified tag names where tag and+-- text are the same string type+type UNodes text a = Nodes text text a++-- | Type shortcut for a single annotated node with unqualified tag names where+-- tag and text are the same string type+type UNode text a = Node text text a++-- | Type shortcut for a single annotated node, annotated with parse location+type LNode tag text = Node tag text XMLParseLocation++-- | Type shortcut for annotated nodes with location information.+type LNodes tag text = [Node tag text XMLParseLocation]++-- | Type shortcut for a single node with unqualified tag names where+-- tag and text are the same string type, annotated with parse location+type ULNode text = LNode text text ++-- | Type shortcut for nodes with unqualified tag names where+-- tag and text are the same string type, annotated with parse location+type ULNodes text = LNodes text text++-- | Type shortcut for annotated nodes where qualified names are used for tags+type QNodes text a = Nodes (QName text) text a++-- | Type shortcut for nodes where qualified names are used for tags, annotated with parse location+type QLNodes text = LNodes (QName text) text++-- | Type shortcut for a single annotated node where qualified names are used for tags+type QNode text a = Node (QName text) text a++-- | Type shortcut for a single node where qualified names are used for tags, annotated with parse location+type QLNode text = LNode (QName text) text++-- | Type shortcut for annotated nodes where namespaced names are used for tags+type NNodes text a = Nodes (NName text) text a++-- | Type shortcut for nodes where namespaced names are used for tags, annotated with parse location+type NLNodes text = LNodes (NName text) text++-- | Type shortcut for a single annotated node where namespaced names are used for tags+type NNode text a = Node (NName text) text a++-- | Type shortcut for a single node where namespaced names are used for tags, annotated with parse location+type NLNode text = LNode (NName text) text++instance Functor (Node tag text) where+    f `fmap` Element na at ch an = Element na at (map (f `fmap`) ch) (f an)+    f `fmap` Text t = Text t++-- | A lower level function that lazily converts a SAX stream into a tree structure.+-- Variant that takes annotations for start tags.+saxToTree :: GenericXMLString tag =>+             [(SAXEvent tag text, a)]+          -> (Node tag text a, Maybe XMLParseError)+saxToTree events =+    let (nodes, mError, _) = ptl events+    in  (safeHead nodes, mError)+  where+    safeHead (a:_) = a+    safeHead [] = Element (gxFromString "") [] [] (error "saxToTree null annotation")+    ptl ((StartElement name attrs, ann):rem) =+        let (children, err1, rem') = ptl rem+            elt = Element name attrs children ann+            (out, err2, rem'') = ptl rem'+        in  (elt:out, err1 `mplus` err2, rem'')+    ptl ((EndElement name, _):rem) = ([], Nothing, rem)+    ptl ((CharacterData txt, _):rem) =+        let (out, err, rem') = ptl rem+        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)+          -> (LNode tag text, Maybe XMLParseError)+parseTree mEnc bs = saxToTree $ parseSAXLocations 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)+          -> LNode tag text+parseTreeThrowing mEnc bs = fst $ saxToTree $ parseSAXLocationsThrowing mEnc bs++-- | Strictly parse XML to tree. Returns error message or valid parsed tree.+parseTree' :: (GenericXMLString tag, GenericXMLString text) =>+              Maybe Encoding      -- ^ Optional encoding override+           -> B.ByteString        -- ^ Input text (a strict ByteString)+           -> Either XMLParseError (LNode tag text)+parseTree' mEnc bs = case parseTree mEnc (L.fromChunks [bs]) of+    (_, Just err)   -> Left err+    (root, Nothing) -> Right root +

@@ -102,13 +102,11 @@     B.concat [pack "</", gxToByteString name, B.singleton (c2w '>')]:putSAX elts putSAX (CharacterData txt:elts) =     B.concat (escapeText (gxToByteString txt)):putSAX elts+putSAX (FailDocument _:elts) = putSAX elts putSAX [] = []  pack :: String -> B.ByteString pack = B.pack . map c2w--unpack :: L.ByteString -> String-unpack = map w2c . L.unpack  escapees :: [Word8] escapees = map c2w "&<\"'"

@@ -1,3 +1,5 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ -- hexpat, a Haskell wrapper for expat -- Copyright (C) 2008 Evan Martin <martine@danga.com> -- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam>@@ -101,7 +103,7 @@  unStatus :: CInt -> Bool unStatus 0 = False-unStatus 1 = True+unStatus _ = True  -- |@parse data@ feeds /lazy/ ByteString data into a 'Parser'. It returns Nothing -- on success, or Just the parse error.@@ -348,20 +350,20 @@         writeIORef charRef $ wrapCharacterDataHandler parser handler  pairwise (x1:x2:xs) = (x1,x2) : pairwise xs-pairwise []         = []+pairwise _          = []  -foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_ParserCreate"+foreign import ccall unsafe "XML_ParserCreate"   parserCreate'_ :: ((Ptr CChar) -> (IO (Ptr ()))) -foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetStartElementHandler"+foreign import ccall unsafe "XML_SetStartElementHandler"   xmlSetstartelementhandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO ()))))) -> (IO ()))) -foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetEndElementHandler"+foreign import ccall unsafe "XML_SetEndElementHandler"   xmlSetendelementhandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (IO ())))) -> (IO ()))) -foreign import ccall unsafe "Text/XML/Expat/IO.chs.h XML_SetCharacterDataHandler"+foreign import ccall unsafe "XML_SetCharacterDataHandler"   xmlSetcharacterdatahandler :: ((Ptr ()) -> ((FunPtr ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (IO ()))))) -> (IO ()))) -foreign import ccall safe "Text/XML/Expat/IO.chs.h XML_Parse"+foreign import ccall safe "XML_Parse"   doParseChunk'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO CInt)))))

@@ -96,4 +96,3 @@     tag (QName (Just prefix) local) = prefix `mappend` gxFromChar ':' `mappend` local     tag (QName Nothing       local) = local -

@@ -91,6 +91,7 @@   UNode,   UNodes,   UAttributes,+  textContent,   extractText,   -- * Parse to tree   parseTree,@@ -105,8 +106,9 @@   parseSAXLocations,   -- * Variants that throw exceptions   XMLParseException(..),-  parseSAXThrowing,   parseTreeThrowing,+  parseSAXThrowing,+  parseSAXLocationsThrowing,   -- * Abstraction of string types   GenericXMLString(..) ) where@@ -180,7 +182,7 @@     gxFromChar = T.singleton     gxHead = T.head     gxTail = T.tail-    gxBreakOn c = T.break (==c)+    gxBreakOn c = T.breakBy (==c)     gxFromCStringLen cstr = TE.decodeUtf8 <$> peekByteStringLen cstr     gxToByteString = TE.encodeUtf8 @@ -225,9 +227,14 @@  -- | Extract all text content from inside a tag into a single string, including -- any text contained in children.+textContent :: Monoid text => Node tag text -> text+textContent (Element _ _ children) = mconcat $ map textContent children+textContent (Text txt) = txt++-- | Deprecated - renamed to textContent. extractText :: Monoid text => Node tag text -> text-extractText (Element _ _ children) = mconcat $ map extractText children-extractText (Text txt) = txt+{-# DEPRECATED extractText "renamed to textContent" #-}+extractText = textContent  modifyChildren :: ([Node tag text] -> [Node tag text])                -> Node tag text@@ -276,9 +283,12 @@    start name attrs stack = Element name attrs [] : stack   text str (cur:rest) = modifyChildren (Text str:) cur : rest+  text _ [] = impossible   end (cur:parent:rest) =     let node = modifyChildren reverse cur in     modifyChildren (node:) parent : rest+  end _ = impossible+  impossible = error "parseTree' impossible"  data SAXEvent tag text =     StartElement tag [(tag, text)] |@@ -343,16 +353,6 @@  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 variant of parseSAX that gives a document location with each SAX event. parseSAXLocations :: (GenericXMLString tag, GenericXMLString text) =>             Maybe Encoding      -- ^ Optional encoding override@@ -395,6 +395,27 @@             return $ reverse queue ++ rem      runParser $ L.toChunks input++-- | 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 variant of parseSAX that gives a document location with each SAX event.+-- In the event of an error, throw 'XMLParseException'.+parseSAXLocationsThrowing :: (GenericXMLString tag, GenericXMLString text) =>+                             Maybe Encoding      -- ^ Optional encoding override+                          -> L.ByteString        -- ^ Input text (a lazy ByteString)+                          -> [(SAXEvent tag text, XMLParseLocation)]+parseSAXLocationsThrowing mEnc bs = map freakOut $ parseSAXLocations 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 =>

@@ -1,6 +1,6 @@ Cabal-Version: >= 1.4 Name: hexpat-Version: 0.9+Version: 0.10 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser@@ -48,17 +48,17 @@     haskell98,     bytestring,     mtl >= 1.1.0.0,-    text >= 0.1,+    text >= 0.5,     utf8-string >= 0.3.3,     parallel,     containers,     extensible-exceptions >= 0.1 && < 0.2   Exposed-Modules:+    Text.XML.Expat.Annotated,     Text.XML.Expat.Tree,     Text.XML.Expat.Format,     Text.XML.Expat.Namespaced,     Text.XML.Expat.Qualified,     Text.XML.Expat.IO-  Extensions: ForeignFunctionInterface   Extra-Libraries: expat 

@@ -116,16 +116,16 @@         ["start open","start test1","end test1","start hello","end hello","end open"]         l -test_extractText = do+test_textContent = do     let tree = Element "cheese" [("type", "edam")]             [Text "You don't actually ",              Element "sub" [] [Text "have any "],              Text "cheese at all",              Text ", do you?"]-    assertEqual "extractText" "You don't actually have any cheese at all, do you?" (extractText tree)+    assertEqual "textContent" "You don't actually have any cheese at all, do you?" (textContent tree)  main = do-    testXML <- readFile "test.xml"+    testXML <- map w2c . B.unpack <$> B.readFile "test.xml"     -- Remove trailing newline     let testXML' = reverse . dropWhile (== '\n') . reverse $ testXML         docs = simpleDocs ++ [testXML']@@ -159,6 +159,6 @@         TestCase $ test_error3,         TestCase $ test_error4,         TestCase $ test_parse,-        TestCase $ test_extractText+        TestCase $ test_textContent       ]