hexpat 0.12 → 0.13

raw patch · 9 files changed

+184/−86 lines, 9 filesdep +Listdep −haskell98dep ~mtldep ~parallelPVP ok

version bump matches the API change (PVP)

Dependencies added: List

Dependencies removed: haskell98

Dependency ranges changed: mtl, parallel

API changes (from Hackage documentation)

Files

• LICENSE +0/−3
• Text/XML/Expat/Annotated.hs +41/−15
• Text/XML/Expat/Format.hs +23/−5
• Text/XML/Expat/IO.hs +1/−1
• Text/XML/Expat/Namespaced.hs +19/−11
• Text/XML/Expat/NodeClass.hs +41/−25
• Text/XML/Expat/Qualified.hs +2/−2
• Text/XML/Expat/Tree.hs +39/−15
• hexpat.cabal +18/−9

@@ -1,6 +1,3 @@-Copyright (c) 2008 Evan Martin <martine@danga.com>-All rights reserved.- Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies,+        FlexibleContexts #-} -- | 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. --@@ -6,7 +7,8 @@ -- if you want to use both modules. module Text.XML.Expat.Annotated (   -- * Tree structure-  Node(..),+  NodeG(..),+  Node,   Attributes,  -- re-export from Tree   UNode,   UAttributes,@@ -103,35 +105,51 @@ import Text.XML.Expat.Namespaced hiding (NNode, NNodes) import Text.XML.Expat.NodeClass -import Control.Monad (mplus)+import Control.Monad (mplus, mzero) import Control.Parallel.Strategies import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import Data.List.Class import Data.Monoid   -- | Annotated variant of the tree representation of the XML document.-data Node a tag text =+data NodeG a c tag text =     Element {         eName       :: !tag,         eAttributes :: ![(tag,text)],-        eChildren   :: [Node a tag text],+        eChildren   :: c (NodeG a c tag text),         eAnn        :: a     } |     Text !text-    deriving (Eq, Show) +-- | A pure Node that uses a list as its container type.+type Node a = NodeG a []++instance (Show tag, Show text, Show a) => Show (NodeG a [] tag text) where+    show (Element na at ch an) = "Element "++show na++" "++show at++" "++show ch++" "++show an+    show (Text t) = "Text "++show t++instance (Eq tag, Eq text, Eq a) => Eq (NodeG a [] tag text) where+    Element na1 at1 ch1 an1 == Element na2 at2 ch2 an2 =+        na1 == na2 &&+        at1 == at2 &&+        ch1 == ch2 &&+        an1 == an2+    Text t1 == Text t2 = t1 == t2+    _ == _ = False+ eAttrs :: Node a tag text -> [(tag, text)] {-# DEPRECATED eAttrs "use eAttributes instead" #-} eAttrs = eAttributes -instance (NFData tag, NFData text, NFData a) => NFData (Node a tag text) where+instance (NFData tag, NFData text, NFData a) => NFData (NodeG a [] tag text) where     rnf (Element nam att chi ann) = rnf (nam, att, chi, ann)     rnf (Text txt) = rnf txt -instance NodeClass (Node a) where-    textContent (Element _ _ children _) = mconcat $ map textContent children-    textContent (Text txt) = txt+instance (Functor c, List c) => NodeClass (NodeG a) c where+    textContentM (Element _ _ children _) = foldlL mappend mempty $ joinM $ fmap textContentM children+    textContentM (Text txt) = return txt          isElement (Element _ _ _ _) = True     isElement _                 = False@@ -142,15 +160,18 @@     isNamed _  (Text _) = False     isNamed nm (Element nm' _ _ _) = nm == nm' -    getName (Text _)             = gxFromString ""+    getName (Text _)             = mempty     getName (Element name _ _ _) = name      getAttributes (Text _)              = []     getAttributes (Element _ attrs _ _) = attrs -    getChildren (Text _)           = []+    getChildren (Text _)           = mzero     getChildren (Element _ _ ch _) = ch +    getText (Text txt) = txt+    getText (Element _ _ _ _) = mempty+     modifyName _ node@(Text _) = node     modifyName f (Element n a c ann) = Element (f n) a c ann @@ -161,18 +182,23 @@     modifyChildren f (Element n a c ann) = Element n a (f c) ann      mapAllTags _ (Text t) = Text t-    mapAllTags f (Element n a c ann) = Element (f n) (map (first f) a) (map (mapAllTags f) c) ann+    mapAllTags f (Element n a c ann) = Element (f n) (map (first f) a) (fmap (mapAllTags f) c) ann      mapElement _ (Text t) = Text t     mapElement f (Element n a c ann) =         let (n', a', c') = f (n, a, c)         in  Element n' a' c' ann +    mapNodeContainer f (Element n a ch an) = do+        ch' <- f ch+        return $ Element n a ch' an+    mapNodeContainer _ (Text t) = return $ Text t+ -- | Convert an annotated tree (/Annotated/ module) into a non-annotated -- tree (/Tree/ module).  Needed, for example, when you @format@ your tree to -- XML, since @format@ takes a non-annotated tree.-unannotate :: Node a tag text -> Tree.Node tag text-unannotate (Element na at ch _) = (Tree.Element na at (map unannotate ch))+unannotate :: Functor c => NodeG a c tag text -> Tree.NodeG c tag text+unannotate (Element na at ch _) = (Tree.Element na at (fmap unannotate ch)) unannotate (Text t) = Tree.Text t  -- | Type shortcut for a single annotated node with unqualified tag names where

@@ -26,12 +26,17 @@         indent_     ) where +import Text.XML.Expat.NodeClass import Text.XML.Expat.Tree++import Control.Monad import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Internal (c2w, w2c) import Data.Char (isSpace) import Data.List+import Data.List.Class+import Data.Monoid import Data.Word  -- | DEPRECATED: Renamed to 'format'.@@ -73,11 +78,24 @@ xmlHeader :: L.ByteString xmlHeader = L.pack $ map c2w "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" --- | 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]+-- | Flatten a tree structure into SAX events, monadic version.+treeToSAX :: (GenericXMLString tag, GenericXMLString text, Monoid text, NodeClass n c,+              Functor c) =>+             n c tag text -> c (SAXEvent tag text)+treeToSAX node+    | isElement node =+        let name = getName node+            atts = getAttributes node+            children = getChildren node+        in  cons (StartElement name atts) $+            concatL (fmap treeToSAX children)+            `mplus`+            cons (EndElement name) mzero+    | otherwise =+        cons (CharacterData $ getText node) mzero+  where+    concatL :: List l => l (l a) -> l a+    concatL xs = joinL $ foldlL mplus mzero xs  -- | Format SAX events with no header - lazy variant that returns lazy ByteString. formatSAX :: (GenericXMLString tag, GenericXMLString text) =>

@@ -55,7 +55,7 @@ import qualified Data.ByteString.Lazy as BSL import Data.IORef import Foreign-import CForeign+import Foreign.C   -- |Opaque parser type.

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} module Text.XML.Expat.Namespaced       ( NName (..)       , NNode@@ -85,17 +86,20 @@    , (Just xmlnsUri, Just xmlns)    ] -toNamespaced :: (NodeClass n, GenericXMLString text, Ord text, Show text)-               => n (QName text) text -> n (NName text) text+toNamespaced :: (NodeClass n c, GenericXMLString text, Ord text, Show text,+                    Functor c)+               => n c (QName text) text -> n c (NName text) text toNamespaced = nodeWithNamespaces baseNsBindings -nodeWithNamespaces :: (NodeClass n, GenericXMLString text, Ord text, Show text)-                   => NsPrefixMap text -> n (QName text) text -> n (NName text) text+nodeWithNamespaces :: (NodeClass n c, GenericXMLString text, Ord text, Show text,+                          Functor c)+                   => NsPrefixMap text -> n c (QName text) text -> n c (NName text) text nodeWithNamespaces bindings = mapElement namespaceify   where     namespaceify (qname, qattrs, qchildren) = (nname, nattrs, nchildren)       where         for = flip map+        ffor = flip fmap         (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)@@ -120,22 +124,26 @@         nDfAtt      = map transAt dfAtt         nNormalAtts = map transAt normalAtts         nattrs      = concat [nNsAtts, nDfAtt, nNormalAtts]-    -        nchildren   = for qchildren $ nodeWithNamespaces chldBs -fromNamespaced :: (NodeClass n, GenericXMLString text, Ord text) =>-                  n (NName text) text -> n (QName text) text+        nchildren   = ffor qchildren $ nodeWithNamespaces chldBs++fromNamespaced :: (NodeClass n c, GenericXMLString text, Ord text,+                      Functor c) =>+                  n c (NName text) text -> n c (QName text) text fromNamespaced = nodeWithQualifiers 1 basePfBindings -nodeWithQualifiers :: (NodeClass n, GenericXMLString text, Ord text) =>+nodeWithQualifiers :: (NodeClass n c, GenericXMLString text, Ord text,+                          Functor c) =>                       Int                    -> PrefixNsMap text-                   -> n (NName text) text -> n (QName text) text+                   -> n c (NName text) text+                   -> n c (QName text) text nodeWithQualifiers cntr bindings = mapElement namespaceify   where     namespaceify (nname, nattrs, nchildren) = (qname, qattrs, qchildren)        where         for = flip map+        ffor = flip fmap         (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)@@ -161,4 +169,4 @@         (_,                       qas)         = L.mapAccumL transAt (i'''', bs'''', as'''') as''''         qattrs = concat [qNsAtts, qDfAtt, qNormalAtts, qas]     -        qchildren = for nchildren $ nodeWithQualifiers i'''' bs''''+        qchildren = ffor nchildren $ nodeWithQualifiers i'''' bs''''

@@ -1,67 +1,83 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies #-} -- | A typeclass to allow for functions that work with different node types -- such as the ones defined in /Tree/ and /Annotated/. module Text.XML.Expat.NodeClass where +import Control.Monad.Identity+import Data.List.Class import Data.Monoid (Monoid) import Text.XML.Expat.SAX (GenericXMLString)  -class NodeClass n where+-- | Extract all text content from inside a tag into a single string, including+-- any text contained in children.+textContent :: (NodeClass n [], Monoid text) => n [] tag text -> text+textContent node = runIdentity $ textContentM node++class List c => NodeClass n c where     -- | Is the given node an element?-    isElement :: n tag text -> Bool+    isElement :: n c tag text -> Bool      -- | Is the given node text?-    isText :: n tag text -> Bool+    isText :: n c tag text -> Bool      -- | Extract all text content from inside a tag into a single string, including     -- any text contained in children.-    textContent :: Monoid text => n tag text -> text+    textContentM :: Monoid text => n c tag text -> ItemM c text      -- | Is the given node a tag with the given name?-    isNamed :: Eq tag => tag -> n tag text -> Bool+    isNamed :: Eq tag => tag -> n c tag text -> Bool      -- | Get the name of this node if it's an element, return empty string otherwise.-    getName :: GenericXMLString tag => n tag text -> tag+    getName :: Monoid tag => n c tag text -> tag      -- | Get the attributes of a node if it's an element, return empty list otherwise.-    getAttributes :: n tag text -> [(tag,text)]+    getAttributes :: n c tag text -> [(tag,text)]      -- | Get children of a node if it's an element, return empty list otherwise.-    getChildren :: n tag text -> [n tag text]+    getChildren :: n c tag text -> c (n c tag text) +    -- | Get this node's text if it's a text node, return empty text otherwise.+    getText :: Monoid text => n c tag text -> text+     -- | Modify name if it's an element, no-op otherwise.     modifyName :: (tag -> tag)-               -> n tag text-               -> n tag text+               -> n c tag text+               -> n c tag text      -- | Modify attributes if it's an element, no-op otherwise.     modifyAttributes :: ([(tag, text)] -> [(tag, text)])-                     -> n tag text-                     -> n tag text+                     -> n c tag text+                     -> n c tag text      -- | Modify children (non-recursively) if it's an element, no-op otherwise.-    modifyChildren :: ([n tag text] -> [n tag text])-                   -> n tag text-                   -> n tag text+    modifyChildren :: (c (n c tag text) -> c (n c tag text))+                   -> n c tag text+                   -> n c tag text      -- | Map all tags (both tag names and attribute names) recursively.     mapAllTags :: (tag -> tag')-            -> n tag text-            -> n tag' text+               -> n c tag text+               -> n c tag' text      -- | Map an element non-recursively, allowing the tag type to be changed.-    mapElement :: ((tag, [(tag, text)], [n tag text]) -> (tag', [(tag', text)], [n tag' text]))-                  -> n tag text-                  -> n tag' text+    mapElement :: ((tag, [(tag, text)], c (n c tag text))+                       -> (tag', [(tag', text)], c (n c tag' text)))+                  -> n c tag text+                  -> n c tag' text +    -- | Change a node from one container type to another.+    mapNodeContainer :: (c (n c tag text) -> ItemM c (c' (n c' tag text)))+                     -> n c tag text+                     -> ItemM c (n c' tag text)+ -- | Get the value of the attribute having the specified name.-getAttribute :: (NodeClass n, GenericXMLString tag) => n tag text -> tag -> Maybe text+getAttribute :: (NodeClass n c, GenericXMLString tag) => n c tag text -> tag -> Maybe text getAttribute n t = lookup t $ getAttributes n  -- | Set the value of the attribute with the specified name to the value, overwriting -- the first existing attribute with that name if present.-setAttribute :: (Eq tag, NodeClass n, GenericXMLString tag) => tag -> text -> n tag text -> n tag text+setAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> text -> n c tag text -> n c tag text setAttribute t newValue = modifyAttributes set   where     set [] = [(t, newValue)]@@ -69,7 +85,7 @@     set (att:atts) = att:set atts  -- | Delete the first attribute matching the specified name.-deleteAttribute :: (Eq tag, NodeClass n, GenericXMLString tag) => tag -> n tag text -> n tag text+deleteAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> n c tag text -> n c tag text deleteAttribute t = modifyAttributes del   where     del [] = []@@ -77,7 +93,7 @@     del (att:atts) = att:del atts  -- | setAttribute if /Just/, deleteAttribute if /Nothing/.-alterAttribute :: (Eq tag, NodeClass n, GenericXMLString tag) => tag -> Maybe text -> n tag text -> n tag text+alterAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> Maybe text -> n c tag text -> n c tag text alterAttribute t (Just newValue) = setAttribute t newValue alterAttribute t Nothing = deleteAttribute t 

@@ -63,7 +63,7 @@ mkAnQName :: text -> QName text mkAnQName localPart = QName Nothing localPart -toQualified :: (NodeClass n, GenericXMLString text) => n text text -> n (QName text) text+toQualified :: (NodeClass n c, GenericXMLString text) => n c text text -> n c (QName text) text toQualified = mapAllTags qual   where     qual ident =@@ -73,7 +73,7 @@                                  -> QName (Just prefix) (gxTail _local)              _                   -> QName Nothing ident -fromQualified :: (NodeClass n, GenericXMLString text) => n (QName text) text -> n text text+fromQualified :: (NodeClass n c, GenericXMLString text) => n c (QName text) text -> n c text text fromQualified = mapAllTags tag   where     tag (QName (Just prefix) local) = prefix `mappend` gxFromChar ':' `mappend` local

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances,-        MultiParamTypeClasses #-}+        MultiParamTypeClasses, TypeFamilies #-}  -- hexpat, a Haskell wrapper for expat -- Copyright (C) 2008 Evan Martin <martine@danga.com>@@ -94,7 +94,8 @@  module Text.XML.Expat.Tree (   -- * Tree structure-  Node(..),+  NodeG(..),+  Node,   Attributes,   UNode,   UAttributes,@@ -165,32 +166,47 @@  ------------------------------------------------------------------------------ import Control.Arrow+import Control.Monad (forM, mplus, mzero) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as L import Data.IORef-import Data.Monoid (Monoid,mconcat)+import Data.List.Class+import Data.Monoid (Monoid,mempty,mappend) import Control.Parallel.Strategies-import Control.Monad import System.IO.Unsafe import Foreign.C.String import Foreign.Ptr   -- | The tree representation of the XML document.-data Node tag text =+data NodeG c tag text =     Element {         eName       :: !tag,         eAttributes :: ![(tag,text)],-        eChildren   :: [Node tag text]+        eChildren   :: c (NodeG c tag text)     } |     Text !text-    deriving (Eq, Show) +instance (Show tag, Show text) => Show (NodeG [] tag text) where+    show (Element na at ch) = "Element "++show na++" "++show at++" "++show ch+    show (Text t) = "Text "++show t++instance (Eq tag, Eq text) => Eq (NodeG [] tag text) where+    Element na1 at1 ch1 == Element na2 at2 ch2 =+        na1 == na2 &&+        at1 == at2 &&+        ch1 == ch2+    Text t1 == Text t2 = t1 == t2+    _ == _ = False++-- | A pure Node that uses a list as its container type.+type Node = NodeG []+ eAttrs :: Node tag text -> [(tag, text)] {-# DEPRECATED eAttrs "use eAttributes instead" #-} eAttrs = eAttributes -instance (NFData tag, NFData text) => NFData (Node tag text) where+instance (NFData tag, NFData text) => NFData (NodeG [] tag text) where     rnf (Element nam att chi) = rnf (nam, att, chi)     rnf (Text txt) = rnf txt @@ -218,10 +234,10 @@ -- text are the same string type. type UAttributes text = Attributes text text -instance NodeClass Node where-    textContent (Element _ _ children) = mconcat $ map textContent children-    textContent (Text txt) = txt-    +instance (Functor c, List c) => NodeClass NodeG c where+    textContentM (Element _ _ children) = foldlL mappend mempty $ joinM $ fmap textContentM children+    textContentM (Text txt) = return txt+     isElement (Element _ _ _) = True     isElement _               = False     @@ -231,14 +247,17 @@     isNamed _  (Text _) = False     isNamed nm (Element nm' _ _) = nm == nm' -    getName (Text _)             = gxFromString ""+    getName (Text _)             = mempty     getName (Element name _ _)   = name      getAttributes (Text _)            = []     getAttributes (Element _ attrs _) = attrs -    getChildren (Text _)         = []+    getChildren (Text _)         = mzero     getChildren (Element _ _ ch) = ch+    +    getText (Text txt) = txt+    getText (Element _ _ _) = mempty      modifyName _ node@(Text _) = node     modifyName f (Element n a c) = Element (f n) a c@@ -250,12 +269,17 @@     modifyChildren f (Element n a c) = Element n a (f c)      mapAllTags _ (Text t) = Text t-    mapAllTags f (Element n a c) = Element (f n) (map (first f) a) (map (mapAllTags f) c)+    mapAllTags f (Element n a c) = Element (f n) (map (first f) a) (fmap (mapAllTags f) c)      mapElement _ (Text t) = Text t     mapElement f (Element n a c) =         let (n', a', c') = f (n, a, c)         in  Element n' a' c'++    mapNodeContainer f (Element n a ch) = do+        ch' <- f ch+        return $ Element n a ch'+    mapNodeContainer _ (Text t) = return $ Text t  setEntityDecoder :: (GenericXMLString tag, GenericXMLString text)                  => Parser

@@ -1,6 +1,6 @@-Cabal-Version: >= 1.4+Cabal-Version: >= 1.6 Name: hexpat-Version: 0.12+Version: 0.13 Synopsis: wrapper for expat, the fast XML parser Description:   This package provides a general purpose Haskell XML library using Expat to@@ -18,12 +18,18 @@   .   The design goals are speed, speed, speed, interface simplicity and modular design.   .-  Examples and benchmarks: <http://haskell.org/haskellwiki/Hexpat/>+  For examples, see /Text.XML.Expat.Tree/ module. For benchmarks, <http://haskell.org/haskellwiki/Hexpat/>   .-  DARCS repository: <http://code.haskell.org/hexpat/>+  Credits to Iavor Diatchki and the @xml@ (XML.Light) package for /Proc/ and /Cursor/.   .-  Credits to Iavor Diatchki <iavor.diatchki@gmail.com> and the @xml@ (XML.Light)-  package for /Proc/ and /Cursor/.+  INSTALLATION: Unix install requires an OS package called something like @libexpat-dev@.+  On MacOSX, expat comes with Apple's optional X11 package, or you can install it from source.+  To install on Windows, first install the Windows binary that's available from+  <http://expat.sourceforge.net/>, then type (assuming you're using v2.0.1):+  .+  @cabal install hexpat --extra-lib-dirs="C:\\Program Files\\Expat 2.0.1\\Bin" --extra-include-dirs="C:\\Program Files\\Expat 2.0.1\\Source\\Lib"@+  .+  Ensure @libexpat.dll@ can be found in your system PATH (or copy it into your executable's directory). Category: XML License: BSD3 License-File: LICENSE@@ -44,18 +50,21 @@ Homepage: http://haskell.org/haskellwiki/Hexpat/ Build-Type: Simple Stability: beta+source-repository head+    type:     darcs+    location: http://code.haskell.org/hexpat/  Library   Build-Depends:     base >= 3 && < 5,-    haskell98,     bytestring,-    mtl >= 1.1.0.0,+    mtl,     text >= 0.5,     utf8-string >= 0.3.3,     parallel,     containers,-    extensible-exceptions >= 0.1 && < 0.2+    extensible-exceptions >= 0.1 && < 0.2,+    List >= 0.2   Exposed-Modules:     Text.XML.Expat.Annotated,     Text.XML.Expat.Cursor,