diff --git a/hxt.cabal b/hxt.cabal --- a/hxt.cabal +++ b/hxt.cabal @@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name: hxt -Version: 9.3.1.7 +Version: 9.3.1.9 Synopsis: A collection of tools for processing XML with Haskell. Description: The Haskell XML Toolbox bases on the ideas of HaXml and HXML, but introduces a more general approach for processing XML with Haskell. @@ -16,6 +16,12 @@ hxt-regex-xmlschema contain the extensions. hxt-unicode contains encoding and decoding functions, hxt-charproperties char properties for unicode and XML. + . + Changes from 9.3.1.8: Bug in hread removed + . + Changes from 9.3.1.7: Foldable and Traversable instances for NTree added + Control.Except used instead of deprecated Control.Error + . Changes from 9.3.1.6: canonicalize added in hread and hreadDoc . Changes from 9.3.1.4: conditionally (no default) @@ -193,16 +199,16 @@ extensions: MultiParamTypeClasses DeriveDataTypeable FunctionalDependencies FlexibleInstances - build-depends: base >= 4 && < 5, - containers >= 0.2 && < 1, - directory >= 1 && < 2, - filepath >= 1 && < 2, - parsec >= 2.1 && < 4, - HUnit >= 1.2 && < 2, - mtl >= 2 && < 3, - deepseq >= 1.1 && < 2, - bytestring >= 0.9 && < 1, - binary >= 0.5 && < 1, + build-depends: base >= 4 && < 5, + containers >= 0.2 && < 1, + directory >= 1 && < 2, + filepath >= 1 && < 2, + parsec >= 2.1 && < 4, + HUnit >= 1.2 && < 2, + mtl >= 2.2.1 && < 3, + deepseq >= 1.1 && < 2, + bytestring >= 0.9 && < 1, + binary >= 0.5 && < 1, hxt-charproperties >= 9.1 && < 10, hxt-unicode >= 9.0.1 && < 10, hxt-regex-xmlschema >= 9 && < 10 diff --git a/src/Data/Tree/NTree/TypeDefs.hs b/src/Data/Tree/NTree/TypeDefs.hs --- a/src/Data/Tree/NTree/TypeDefs.hs +++ b/src/Data/Tree/NTree/TypeDefs.hs @@ -22,12 +22,16 @@ module Data.Tree.NTree.TypeDefs where -import Control.DeepSeq -import Control.FlatSeq +import Control.Applicative (Applicative (..), (<$>)) +import Control.DeepSeq (NFData (..)) +import Control.FlatSeq (WNFData (..), rlnf) -import Data.Binary -import Data.Tree.Class -import Data.Typeable +import Data.Binary +import Data.Foldable (Foldable (..)) +import Data.Monoid (Monoid (..), (<>)) +import Data.Traversable (Traversable (..), sequenceA) +import Data.Tree.Class (Tree (..)) +import Data.Typeable (Typeable) -- ------------------------------------------------------------ @@ -75,8 +79,25 @@ -- | NTree implements class Functor instance Functor NTree where - fmap f ~(NTree n cl) = NTree (f n) (map (fmap f) cl) + fmap f (NTree n cl) = NTree (f n) (map (fmap f) cl) {-# INLINE fmap #-} + +-- ------------------------------------------------------------ + +-- | NTree implements class Foldable + +instance Foldable NTree where + foldMap f (NTree n cl) = f n <> mconcat (map (foldMap f) cl) + {-# INLINE foldMap #-} + + +-- ------------------------------------------------------------ + +-- | NTree implements class Taversable + +instance Traversable NTree where + traverse f (NTree n cl) = NTree <$> f n <*> sequenceA (map (traverse f) cl) + {-# INLINE traverse #-} -- ------------------------------------------------------------ diff --git a/src/Text/XML/HXT/Arrow/Edit.hs b/src/Text/XML/HXT/Arrow/Edit.hs --- a/src/Text/XML/HXT/Arrow/Edit.hs +++ b/src/Text/XML/HXT/Arrow/Edit.hs @@ -108,10 +108,12 @@ canonicalizeTree' :: LA XmlTree XmlTree -> LA XmlTree XmlTree canonicalizeTree' toBeRemoved - = processChildren - ( (none `when` (isText <+> isXmlPi)) -- remove XML PI and all text around XML root element - >>> - (deep isPi `when` isDTD) -- remove DTD parts, except PIs whithin DTD + = ( processChildren + ( (none `when` (isText <+> isXmlPi)) -- remove XML PI and all text around XML root element + >>> + (deep isPi `when` isDTD) -- remove DTD parts, except PIs whithin DTD + ) + `when` isRoot ) >>> canonicalizeNodes toBeRemoved diff --git a/src/Text/XML/HXT/Arrow/Pickle/Xml.hs b/src/Text/XML/HXT/Arrow/Pickle/Xml.hs --- a/src/Text/XML/HXT/Arrow/Pickle/Xml.hs +++ b/src/Text/XML/HXT/Arrow/Pickle/Xml.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} -- ------------------------------------------------------------ @@ -49,27 +49,28 @@ module Text.XML.HXT.Arrow.Pickle.Xml where -import Control.Applicative +import Control.Applicative (Applicative (..)) import Control.Arrow.ArrowList import Control.Arrow.ListArrows -import Control.Monad ( ) -import Control.Monad.Error -import Control.Monad.State +import Control.Monad () +import Control.Monad.Except (MonadError (..)) +import Control.Monad.State (MonadState (..), gets, + modify) import Data.Char (isDigit) import Data.List (foldl') -import Data.Maybe import Data.Map (Map) import qualified Data.Map as M +import Data.Maybe (fromJust, fromMaybe) -import Text.XML.HXT.DOM.Interface -import qualified Text.XML.HXT.DOM.XmlNode as XN -import qualified Text.XML.HXT.DOM.ShowXml as XN import Text.XML.HXT.Arrow.Edit (xshowEscapeXml) import Text.XML.HXT.Arrow.Pickle.Schema import Text.XML.HXT.Arrow.ReadDocument (xread) import Text.XML.HXT.Arrow.WriteDocument (writeDocumentToString) import Text.XML.HXT.Arrow.XmlState +import Text.XML.HXT.DOM.Interface +import qualified Text.XML.HXT.DOM.ShowXml as XN +import qualified Text.XML.HXT.DOM.XmlNode as XN {- just for embedded test cases, prefix with -- to activate import Text.XML.HXT.Arrow.XmlArrow @@ -1172,7 +1173,7 @@ data Stmt = Assign Ident Expr - | Stmts StmtList + | Stmts StmtList | If Expr Stmt (Maybe Stmt) | While Expr Stmt deriving (Eq, Show) @@ -1314,7 +1315,7 @@ p0 = Stmts [] -- the empty program -p1 = Stmts +p1 = Stmts [ Assign i ( UnExpr UMinus ( IntConst (-22) ) ) , Assign j ( IntConst 20 ) , While @@ -1330,7 +1331,7 @@ i = "i" j = "j" -p2 = Stmts +p2 = Stmts [ Assign x (IntConst 6) , Assign y (IntConst 7) , Assign p (IntConst 0) diff --git a/src/Text/XML/HXT/Arrow/ReadDocument.hs b/src/Text/XML/HXT/Arrow/ReadDocument.hs --- a/src/Text/XML/HXT/Arrow/ReadDocument.hs +++ b/src/Text/XML/HXT/Arrow/ReadDocument.hs @@ -38,6 +38,7 @@ import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.Edit ( canonicalizeAllNodes , canonicalizeForXPath + , canonicalizeContents , rememberDTDAttrl , removeDocWhiteSpace ) @@ -485,18 +486,22 @@ >>> -- as well as subst HTML char refs editNTreeA [isError :-> none] -- ignores all errors >>> - canonicalizeAllNodes -- combine text nodes, substitute char refs + canonicalizeContents -- combine text nodes, substitute char refs + -- comments are not removed -- | like hread, but accepts a whole document, not a HTML content hreadDoc :: ArrowXml a => a String XmlTree hreadDoc = fromLA $ - PI.hreadDoc -- substHtmlEntityRefs is done in parser + root [] [PI.hreadDoc] -- substHtmlEntityRefs is done in parser >>> -- as well as subst HTML char refs editNTreeA [isError :-> none] -- ignores all errors >>> - canonicalizeAllNodes + canonicalizeForXPath -- remove DTD spec and text in content of root node + -- and do a canonicalizeContents + >>> + getChildren -- ------------------------------------------------------------