hexpat 0.8 → 0.9

raw patch · 4 files changed

+81/−60 lines, 4 filesdep −binarydep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: binary

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Text/XML/Expat/Format.hs +78/−54
• Text/XML/Expat/Qualified.hs +0/−1
• Text/XML/Expat/Tree.hs +0/−1
• hexpat.cabal +3/−4

@@ -3,17 +3,21 @@ -- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam>  -- | This module provides functions to format a tree--- structure as UTF-8 encoded XML.+-- structure or SAX stream as UTF-8 encoded XML.  {-# LANGUAGE FlexibleContexts #-}  module Text.XML.Expat.Format (+        -- * High level         formatTree,         formatTree',         formatNode,         formatNode',-        putTree,-        putNode+        -- * Low level+        xmlHeader,+        treeToSAX,+        formatSAX,+        formatSAX'     ) where  import Text.XML.Expat.IO@@ -23,84 +27,104 @@ import Data.ByteString.Internal (c2w, w2c) import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import Data.Binary.Put-import Control.Monad+import Data.Word  -- | Format document with <?xml.. header - lazy variant that returns lazy ByteString. formatTree :: (GenericXMLString tag, GenericXMLString text) =>               Node tag text            -> L.ByteString-formatTree node = runPut $ putTree node+formatTree node = xmlHeader `L.append` formatNode node  -- | 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+formatTree' = B.concat . L.toChunks . formatTree  -- | Format XML node with no header - lazy variant that returns lazy ByteString. formatNode :: (GenericXMLString tag, GenericXMLString text) =>               Node tag text            -> L.ByteString-formatNode node = runPut $ putNode node+formatNode = formatSAX . treeToSAX  -- | 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+formatNode' = B.concat . L.toChunks . formatNode --- | 'Data.Binary.Put.Put' interface for formatting a tree with <?xml.. header.-putTree :: (GenericXMLString tag, GenericXMLString text) =>-           Node tag text-        -> Put-putTree node = do-    putByteString $ pack "<?xml version=\"1.0\""-    putByteString $ pack " encoding=\"UTF-8\""-    putByteString $ pack "?>\n"-    putNode node+xmlHeader :: L.ByteString+xmlHeader = L.pack $ map c2w "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" --- | 'Data.Binary.Put.Put' interface for formatting a node with no header.-putNode :: (GenericXMLString tag, GenericXMLString text) =>-           Node tag text-        -> Put-putNode (Element name attrs children) = do-    putWord8 $ c2w '<'-    let putThisTag = putByteString $ gxToByteString name-    putThisTag-    forM_ attrs $ \(aname, avalue) -> do-        putWord8 $ c2w ' '-        putByteString $ gxToByteString aname-        putByteString $ pack "=\""-        putXMLText $ gxToByteString avalue-        putByteString $ pack "\""-    if null children-        then-            putByteString $ pack "/>"-        else do-            putWord8 $ c2w '>'-            forM_ children putNode-            putByteString $ pack "</"-            putThisTag-            putWord8 $ c2w '>'-    flush-putNode (Text txt) =-    putXMLText $ gxToByteString txt+-- | Flatten a tree structure into SAX events.+treeToSAX :: Node tag text -> [SAXEvent tag text]+treeToSAX (Element name atts children) =+        StartElement name atts : concatMap treeToSAX children ++ [EndElement name]+treeToSAX (Text txt) = [CharacterData txt] +-- | Format SAX events with no header - lazy variant that returns lazy ByteString.+formatSAX :: (GenericXMLString tag, GenericXMLString text) =>+             [SAXEvent tag text]+          -> L.ByteString+formatSAX = L.fromChunks . putSAX++-- | Format SAX events with no header - strict variant that returns strict ByteString.+formatSAX' :: (GenericXMLString tag, GenericXMLString text) =>+              [SAXEvent tag text]+           -> B.ByteString+formatSAX' = B.concat . L.toChunks . formatSAX++-- Do start tag and attributes but omit closing >+startTagHelper :: (GenericXMLString tag, GenericXMLString text) =>+                  tag+               -> [(tag, text)]+               -> [B.ByteString]+startTagHelper name atts =+    B.singleton (c2w '<'):+    gxToByteString name:+    concatMap (+            \(aname, avalue) ->+                B.singleton (c2w ' '):+                gxToByteString aname:+                pack "=\"":+                escapeText (gxToByteString avalue)+++                [B.singleton (c2w '"')]+        ) atts++putSAX :: (GenericXMLString tag, GenericXMLString text) =>+           [SAXEvent tag text]+        -> [B.ByteString]+putSAX (StartElement name attrs:EndElement name2:elts) =+    B.concat (startTagHelper name attrs ++ [pack "/>"]):putSAX elts+putSAX (StartElement name attrs:elts) =+    B.concat (startTagHelper name attrs ++ [B.singleton (c2w '>')]):putSAX elts+putSAX (EndElement name:elts) =+    B.concat [pack "</", gxToByteString name, B.singleton (c2w '>')]:putSAX elts+putSAX (CharacterData txt:elts) =+    B.concat (escapeText (gxToByteString txt)):putSAX elts+putSAX [] = []+ pack :: String -> B.ByteString pack = B.pack . map c2w  unpack :: L.ByteString -> String unpack = map w2c . L.unpack -putXMLText :: B.ByteString -> Put-putXMLText str | B.null str = return ()-putXMLText str = do-    case w2c $ B.head str of-        '&'  -> putByteString $ pack "&amp;"-        '<'  -> putByteString $ pack "&lt;"-        '"'  -> putByteString $ pack "&quot;"-        '\'' -> putByteString $ pack "&apos;"-        ch   -> putWord8 (c2w ch)-    putXMLText $ B.tail str+escapees :: [Word8]+escapees = map c2w "&<\"'"++escapeText :: B.ByteString -> [B.ByteString]+escapeText str | B.null str = []+escapeText str =+    let (good, bad) = B.span (`notElem` escapees) str+    in  if B.null good+            then case w2c $ B.head str of+                '&'  -> pack "&amp;":escapeText rem+                '<'  -> pack "&lt;":escapeText rem+                '"'  -> pack "&quot;":escapeText rem+                '\'' -> pack "&apos;":escapeText rem+                _        -> error "hexpat: impossible"+            else good:escapeText bad+  where+    rem = B.tail str 

@@ -33,7 +33,6 @@ import Control.Monad.Writer import Control.Parallel.Strategies import Data.Monoid-import Data.Binary.Put import qualified Codec.Binary.UTF8.String as U8  -- | A qualified name.

@@ -122,7 +122,6 @@ 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.Monoid import Data.Typeable import Control.Exception.Extensible as Exc

@@ -1,6 +1,6 @@-Cabal-Version: >= 1.2+Cabal-Version: >= 1.4 Name: hexpat-Version: 0.8+Version: 0.9 Synopsis: wrapper for expat, the fast XML parser Description:   Expat (<http://expat.sourceforge.net/>) is a stream-oriented XML parser@@ -44,12 +44,11 @@  Library   Build-Depends:-    base,+    base >= 3 && < 5,     haskell98,     bytestring,     mtl >= 1.1.0.0,     text >= 0.1,-    binary >= 0.4,     utf8-string >= 0.3.3,     parallel,     containers,