hxt 9.3.1.13 → 9.3.1.14
raw patch · 19 files changed
+394/−426 lines, 19 filesdep ~basedep ~deepseqPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, deepseq
API changes (from Hackage documentation)
Files
- hxt.cabal +7/−5
- src/Control/Arrow/ArrowNF.hs +8/−8
- src/Data/Atom.hs +8/−7
- src/Data/Tree/NTree/TypeDefs.hs +13/−6
- src/Text/XML/HXT/Arrow/Binary.hs +6/−8
- src/Text/XML/HXT/Arrow/DocumentInput.hs +13/−17
- src/Text/XML/HXT/Arrow/DocumentOutput.hs +30/−38
- src/Text/XML/HXT/Arrow/Edit.hs +12/−12
- src/Text/XML/HXT/Arrow/Pickle/Xml.hs +6/−0
- src/Text/XML/HXT/Arrow/ProcessDocument.hs +29/−38
- src/Text/XML/HXT/Arrow/XmlRegex.hs +6/−6
- src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs +90/−92
- src/Text/XML/HXT/DOM/QualifiedName.hs +27/−28
- src/Text/XML/HXT/DOM/ShowXml.hs +62/−64
- src/Text/XML/HXT/DOM/TypeDefs.hs +11/−10
- src/Text/XML/HXT/DTDValidation/DTDValidation.hs +4/−2
- src/Text/XML/HXT/DTDValidation/Validation.hs +5/−5
- src/Text/XML/HXT/Parser/XmlCharParser.hs +16/−18
- src/Text/XML/HXT/Parser/XmlParsec.hs +41/−62
hxt.cabal view
@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name: hxt-Version: 9.3.1.13+Version: 9.3.1.14 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.@@ -17,6 +17,8 @@ hxt-unicode contains encoding and decoding functions, hxt-charproperties char properties for unicode and XML. .+ Changes from 9.3.1.13: ghc-7.10 compatibility+ . Changes from 9.3.1.12: Bug when unpickling an empty attribute value removed . Changes from 9.3.1.11: Bug fix in haddock comments@@ -59,8 +61,8 @@ Maintainer: Uwe Schmidt <uwe@fh-wedel.de> Stability: Stable Category: XML-Homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html-Copyright: Copyright (c) 2005-2014 Uwe Schmidt+Homepage: https://github.com/UweSchmidt/hxt+Copyright: Copyright (c) 2005-2015 Uwe Schmidt Build-type: Simple Cabal-version: >=1.8 @@ -203,9 +205,9 @@ hs-source-dirs: src ghc-options: -Wall- ghc-prof-options: -auto-all -caf-all+ ghc-prof-options: -caf-all - extensions: MultiParamTypeClasses DeriveDataTypeable FunctionalDependencies FlexibleInstances+ extensions: MultiParamTypeClasses DeriveDataTypeable FunctionalDependencies FlexibleInstances CPP build-depends: base >= 4 && < 5, containers >= 0.2 && < 1,
src/Control/Arrow/ArrowNF.hs view
@@ -18,11 +18,11 @@ module Control.Arrow.ArrowNF where -import Control.Arrow-import Control.Arrow.ArrowList+import Control.Arrow+import Control.Arrow.ArrowList -import Control.DeepSeq-import Control.FlatSeq+import Control.DeepSeq+import Control.FlatSeq -- | -- complete evaluation of an arrow result using 'Control.DeepSeq'@@ -35,8 +35,8 @@ strictA = arr $ \ x -> deepseq x x class (Arrow a) => ArrowNF a where- rnfA :: (NFData c) => a b c -> a b c- rnfA f = f >>^ (\ x -> deepseq x x)+ rnfA :: (NFData c) => a b c -> a b c+ rnfA f = f >>^ (\ x -> deepseq x x) {-# INLINE rnfA #-} -- |@@ -54,8 +54,8 @@ rwnfA f = f >>. \ x -> rlnf rwnf x `seq` x {-# INLINE rwnfA #-} - rwnf2A :: (WNFData c) => a b c -> a b c- rwnf2A f = f >>. \ x -> rlnf rwnf2 x `seq` x+ rwnf2A :: (WNFData c) => a b c -> a b c+ rwnf2A f = f >>. \ x -> rlnf rwnf2 x `seq` x {-# INLINE rwnf2A #-} -- ------------------------------------------------------------
src/Data/Atom.hs view
@@ -61,15 +61,15 @@ import Control.DeepSeq -import Data.ByteString.Internal ( toForeignPtr, c2w, w2c )-import Data.ByteString ( ByteString, pack, unpack )+import Data.ByteString (ByteString, pack, unpack)+import Data.ByteString.Internal (c2w, toForeignPtr, w2c) import Data.IORef-import qualified Data.Map as M-import Data.String.UTF8Decoding ( decodeUtf8 )-import Data.String.Unicode ( unicodeToUtf8 )+import qualified Data.Map as M+import Data.String.Unicode (unicodeToUtf8)+import Data.String.UTF8Decoding (decodeUtf8) import Data.Typeable -import System.IO.Unsafe ( unsafePerformIO )+import System.IO.Unsafe (unsafePerformIO) -- ------------------------------------------------------------ @@ -108,7 +108,7 @@ -- putStrLn "atom cache updated" return res where- insert m = let r = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m + insert m = let r = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m in fst r `seq` r @@ -138,5 +138,6 @@ -- show = show . toForeignPtr . bs -- for debug only instance NFData Atom where+ rnf x = seq x () -----------------------------------------------------------------------------
src/Data/Tree/NTree/TypeDefs.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -- ------------------------------------------------------------@@ -22,17 +23,23 @@ module Data.Tree.NTree.TypeDefs where -import Control.Applicative (Applicative (..), (<$>))+import Control.Applicative ((<$>)) import Control.DeepSeq (NFData (..)) import Control.FlatSeq (WNFData (..), rlnf) import Data.Binary-import Data.Foldable (Foldable (..))-import Data.Monoid (Monoid (..), (<>))-import Data.Traversable (Traversable (..), sequenceA)+import Data.Monoid ((<>)) import Data.Tree.Class (Tree (..)) import Data.Typeable (Typeable) +#if MIN_VERSION_base(4,8,0)+#else+import Control.Applicative (Applicative (..))+import Data.Foldable (Foldable (..))+import Data.Monoid (Monoid (..))+import Data.Traversable (Traversable (..), sequenceA)+#endif+ -- ------------------------------------------------------------ -- | n-ary ordered tree (rose trees)@@ -58,11 +65,11 @@ {-# INLINE rnf #-} instance (WNFData a) => WNFData (NTree a) where- rwnf (NTree n cl) = rwnf n `seq` rwnf cl+ rwnf (NTree n cl) = rwnf n `seq` rwnf cl {-# INLINE rwnf #-} -- | Evaluate a tree 2 steps deep, the top node and all children are evaluated with rwnf- rwnf2 (NTree n cl) = rwnf n `seq` rlnf rwnf cl+ rwnf2 (NTree n cl) = rwnf n `seq` rlnf rwnf cl {-# INLINE rwnf2 #-} -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/Binary.hs view
@@ -20,18 +20,16 @@ ) where -import Control.Arrow ()+import Control.Arrow () import Control.Arrow.ArrowExc-import Control.Arrow.ArrowList import Control.Arrow.ArrowIO+import Control.Arrow.ArrowList import Data.Binary-import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy as B -import System.IO ( openBinaryFile- , hClose- , IOMode(..)- )+import System.IO (IOMode (..), hClose,+ openBinaryFile) import Text.XML.HXT.Arrow.XmlState.ErrorHandling import Text.XML.HXT.Arrow.XmlState.TypeDefs@@ -65,7 +63,7 @@ B.length c `seq` do hClose h- return c -- hack: force reading whole file and close it immediately+ return c -- hack: force reading whole file and close it immediately -- | Serialize a value, optionally compress it, and write it to a file. -- In case of an error, the error message is issued and the arrow fails
src/Text/XML/HXT/Arrow/DocumentInput.hs view
@@ -24,30 +24,26 @@ ) where -import Control.Arrow -- arrow classes-import Control.Arrow.ArrowList+import Control.Arrow import Control.Arrow.ArrowIf-import Control.Arrow.ArrowTree import Control.Arrow.ArrowIO+import Control.Arrow.ArrowList+import Control.Arrow.ArrowTree import Control.Arrow.ListArrow -import Data.List ( isPrefixOf )-import Data.String.Unicode ( getDecodingFct- , guessEncoding- , normalizeNL- )+import Data.List (isPrefixOf)+import Data.String.Unicode (getDecodingFct,+ guessEncoding,+ normalizeNL) -import System.FilePath ( takeExtension )+import System.FilePath (takeExtension) -import qualified Text.XML.HXT.IO.GetFILE as FILE+import qualified Text.XML.HXT.IO.GetFILE as FILE import Text.XML.HXT.DOM.Interface -import Text.XML.HXT.Arrow.ParserInterface- ( parseXmlDocEncodingSpec- , parseXmlEntityEncodingSpec- , removeEncodingSpec- )+import Text.XML.HXT.Arrow.ParserInterface (parseXmlDocEncodingSpec, parseXmlEntityEncodingSpec,+ removeEncodingSpec) import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlState import Text.XML.HXT.Arrow.XmlState.TypeDefs@@ -258,7 +254,7 @@ getXmlEntityContents = traceMsg 2 "getXmlEntityContents" >>>- addAttr transferMimeType text_xml_external_parsed_entity -- the default transfer mimetype+ addAttr transferMimeType text_xml_external_parsed_entity -- the default transfer mimetype >>> getXmlContents' parseXmlEntityEncodingSpec >>>@@ -267,7 +263,7 @@ processChildren ( removeEncodingSpec >>>- changeText normalizeNL -- newline normalization must be done here+ changeText normalizeNL -- newline normalization must be done here ) -- the following calls of the parsers don't do this >>> setBaseURIFromDoc
src/Text/XML/HXT/Arrow/DocumentOutput.hs view
@@ -24,45 +24,37 @@ ) where -import Control.Arrow -- arrow classes-import Control.Arrow.ArrowList-import Control.Arrow.ArrowIf-import Control.Arrow.ArrowTree-import Control.Arrow.ArrowIO-import Control.Arrow.ListArrow-import Control.Arrow.ArrowExc+import Control.Arrow+import Control.Arrow.ArrowExc+import Control.Arrow.ArrowIf+import Control.Arrow.ArrowIO+import Control.Arrow.ArrowList+import Control.Arrow.ArrowTree+import Control.Arrow.ListArrow -import qualified- Data.ByteString.Lazy as BS-import Data.Maybe-import Data.String.Unicode ( getOutputEncodingFct' )+import qualified Data.ByteString.Lazy as BS+import Data.Maybe+import Data.String.Unicode (getOutputEncodingFct') -import Text.XML.HXT.DOM.Interface-import qualified- Text.XML.HXT.DOM.ShowXml as XS+import Text.XML.HXT.DOM.Interface+import qualified Text.XML.HXT.DOM.ShowXml as XS -import Text.XML.HXT.Arrow.XmlArrow-import Text.XML.HXT.Arrow.Edit ( addHeadlineToXmlDoc- , addXmlPi- , addXmlPiEncoding- , indentDoc- , numberLinesInXmlDoc- , treeRepOfXmlDoc- , escapeHtmlRefs- , escapeXmlRefs- )-import Text.XML.HXT.Arrow.XmlState-import Text.XML.HXT.Arrow.XmlState.TypeDefs+import Text.XML.HXT.Arrow.Edit (addHeadlineToXmlDoc,+ addXmlPi,+ addXmlPiEncoding,+ escapeHtmlRefs,+ escapeXmlRefs, indentDoc,+ numberLinesInXmlDoc,+ treeRepOfXmlDoc)+import Text.XML.HXT.Arrow.XmlArrow+import Text.XML.HXT.Arrow.XmlState+import Text.XML.HXT.Arrow.XmlState.TypeDefs -import System.IO ( Handle- , IOMode(..)- , openFile- , openBinaryFile- , hSetBinaryMode- , hPutStrLn- , hClose- , stdout- )+import System.IO (Handle, IOMode (..),+ hClose, hPutStrLn,+ hSetBinaryMode,+ openBinaryFile, openFile,+ stdout) -- ------------------------------------------------------------ --@@ -220,7 +212,7 @@ encode :: String -> LA XmlTree XmlTree encode encodingScheme | encodingScheme == unicodeString- = replaceChildren+ = replaceChildren ( (getChildren >. XS.xshow'' cQuot aQuot) >>> mkText@@ -244,7 +236,7 @@ addAttr a_output_encoding encodingScheme where (cQuot, aQuot)- | quoteXml = escapeXmlRefs+ | quoteXml = escapeXmlRefs | otherwise = escapeHtmlRefs encodeFct = getOutputEncodingFct' encodingScheme@@ -255,7 +247,7 @@ mkBlob ) xshowBlobWithEnc cenc aenc enc f- = f >. XS.xshow' cenc aenc enc + = f >. XS.xshow' cenc aenc enc -- if encoding scheme is isolatin1 and the contents is a single blob (bytestring) -- the encoding is the identity.
src/Text/XML/HXT/Arrow/Edit.hs view
@@ -64,25 +64,25 @@ where import Control.Arrow-import Control.Arrow.ArrowList import Control.Arrow.ArrowIf+import Control.Arrow.ArrowList import Control.Arrow.ArrowTree import Control.Arrow.ListArrow import Control.Arrow.NTreeEdit -import Data.Char.Properties.XMLCharProps ( isXmlSpaceChar )+import Data.Char.Properties.XMLCharProps (isXmlSpaceChar) import Text.XML.HXT.Arrow.XmlArrow+import Text.XML.HXT.DOM.FormatXmlTree (formatXmlTree) import Text.XML.HXT.DOM.Interface-import qualified Text.XML.HXT.DOM.XmlNode as XN-import qualified Text.XML.HXT.DOM.ShowXml as XS-import Text.XML.HXT.DOM.FormatXmlTree ( formatXmlTree )-import Text.XML.HXT.Parser.HtmlParsec ( emptyHtmlTags )-import Text.XML.HXT.Parser.XmlEntities ( xmlEntities )-import Text.XML.HXT.Parser.XhtmlEntities ( xhtmlEntities )+import qualified Text.XML.HXT.DOM.ShowXml as XS+import qualified Text.XML.HXT.DOM.XmlNode as XN+import Text.XML.HXT.Parser.HtmlParsec (emptyHtmlTags)+import Text.XML.HXT.Parser.XhtmlEntities (xhtmlEntities)+import Text.XML.HXT.Parser.XmlEntities (xmlEntities) -import Data.List ( isPrefixOf )-import qualified Data.Map as M+import Data.List (isPrefixOf)+import qualified Data.Map as M import Data.Maybe -- ------------------------------------------------------------@@ -280,7 +280,7 @@ -- ------------------------------------------------------------ -substXHTMLEntityRef :: LA XmlTree XmlTree+substXHTMLEntityRef :: LA XmlTree XmlTree substXHTMLEntityRef = ( getEntityRef >>>@@ -293,7 +293,7 @@ subst name = maybe [] (:[]) $ M.lookup name xhtmlEntitySubstTable -substAllXHTMLEntityRefs :: ArrowXml a => a XmlTree XmlTree+substAllXHTMLEntityRefs :: ArrowXml a => a XmlTree XmlTree substAllXHTMLEntityRefs = fromLA $ processBottomUp substXHTMLEntityRef
src/Text/XML/HXT/Arrow/Pickle/Xml.hs view
@@ -50,15 +50,21 @@ module Text.XML.HXT.Arrow.Pickle.Xml where +#if MIN_VERSION_base(4,8,0)+#else import Control.Applicative (Applicative (..))+#endif+ import Control.Arrow.ArrowList import Control.Arrow.ListArrows import Control.Monad ()+ #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) #else import Control.Monad.Error (MonadError (..)) #endif+ import Control.Monad.State (MonadState (..), gets, modify)
src/Text/XML/HXT/Arrow/ProcessDocument.hs view
@@ -27,45 +27,36 @@ ) where -import Control.Arrow -- arrow classes-import Control.Arrow.ArrowList-import Control.Arrow.ArrowIf-import Control.Arrow.ArrowTree-import Control.Arrow.ListArrow ( fromLA )-import Control.Arrow.NTreeEdit+import Control.Arrow+import Control.Arrow.ArrowIf+import Control.Arrow.ArrowList+import Control.Arrow.ArrowTree+import Control.Arrow.ListArrow (fromLA)+import Control.Arrow.NTreeEdit -import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.Interface -import Text.XML.HXT.Arrow.XmlArrow-import Text.XML.HXT.Arrow.XmlState-import Text.XML.HXT.Arrow.XmlState.TypeDefs+import Text.XML.HXT.Arrow.XmlArrow+import Text.XML.HXT.Arrow.XmlState+import Text.XML.HXT.Arrow.XmlState.TypeDefs -import Text.XML.HXT.Arrow.ParserInterface ( parseXmlDoc- , parseHtmlDoc- )+import Text.XML.HXT.Arrow.ParserInterface (parseHtmlDoc,+ parseXmlDoc) -import Text.XML.HXT.Arrow.Edit ( transfAllCharRef- , substAllXHTMLEntityRefs- )+import Text.XML.HXT.Arrow.Edit (substAllXHTMLEntityRefs,+ transfAllCharRef) -import Text.XML.HXT.Arrow.GeneralEntitySubstitution- ( processGeneralEntities- )+import Text.XML.HXT.Arrow.GeneralEntitySubstitution (processGeneralEntities) -import Text.XML.HXT.Arrow.DTDProcessing ( processDTD- )+import Text.XML.HXT.Arrow.DTDProcessing (processDTD) -import Text.XML.HXT.Arrow.DocumentInput ( getXmlContents- )+import Text.XML.HXT.Arrow.DocumentInput (getXmlContents) -import Text.XML.HXT.Arrow.Namespace ( propagateNamespaces- , validateNamespaces- )-import Text.XML.HXT.DTDValidation.Validation ( validate- , getDTDSubset- , generalEntitiesDefined- , transform- )+import Text.XML.HXT.Arrow.Namespace (propagateNamespaces, validateNamespaces)+import Text.XML.HXT.DTDValidation.Validation (generalEntitiesDefined,+ getDTDSubset,+ transform,+ validate) -- ------------------------------------------------------------ @@ -105,12 +96,12 @@ ( ifA (fromLA getDTDSubset) ( processDTDandEntities >>>- ( if validate' -- validation only possible if there is a DTD+ ( if validate' -- validation only possible if there is a DTD then validateDocument else this ) )- ( if validate' -- validation only consists of checking+ ( if validate' -- validation only consists of checking -- for undefined entity refs -- predefined XML entity refs are substituted -- in the XML parser into char refs@@ -138,7 +129,7 @@ ) >>> ( if substDTD- then ( processGeneralEntities -- DTD contains general entity definitions+ then ( processGeneralEntities -- DTD contains general entity definitions `when` fromLA generalEntitiesDefined )@@ -149,7 +140,7 @@ >>> transfAllCharRef -checkUndefinedEntityRefs :: IOStateArrow s XmlTree XmlTree+checkUndefinedEntityRefs :: IOStateArrow s XmlTree XmlTree checkUndefinedEntityRefs = deep isEntityRef >>>@@ -226,12 +217,12 @@ ) removeWarnings (warnings, withTagSoup')- | warnings = processTopDownWithAttrl -- remove warnings inserted by parser and entity subst+ | warnings = processTopDownWithAttrl -- remove warnings inserted by parser and entity subst filterErrorMsg- | withTagSoup' = this -- warnings are not generated in tagsoup+ | withTagSoup' = this -- warnings are not generated in tagsoup | otherwise = fromLA $- editNTreeA [isError :-> none] -- remove all warnings from document+ editNTreeA [isError :-> none] -- remove all warnings from document -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/XmlRegex.hs view
@@ -49,12 +49,12 @@ ) where -import Control.Arrow.ListArrows+import Control.Arrow.ListArrows -import Data.Maybe+import Data.Maybe -import Text.XML.HXT.DOM.Interface-import Text.XML.HXT.DOM.ShowXml ( xshow )+import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.ShowXml (xshow) -- ------------------------------------------------------------ -- the exported regex arrows@@ -249,8 +249,8 @@ -- ------------------------------------------------------------ -unexpected :: XmlTree -> String -> String-unexpected t e = emsg e ++ (cut 80 . xshow) [t]+unexpected :: XmlTree -> String -> String+unexpected t e = emsg e ++ (cut 80 . xshow) [t] where emsg "" = "unexpected: " emsg s = "expected: " ++ s ++ ", but got: "
src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs view
@@ -39,21 +39,18 @@ ) where -import Control.Arrow -- arrow classes-import Control.Arrow.ArrowList-import Control.Arrow.IOStateListArrow-import Control.DeepSeq+import Control.Arrow+import Control.Arrow.ArrowList+import Control.Arrow.IOStateListArrow+import Control.DeepSeq -import Data.ByteString.Lazy ( ByteString )-import Data.Char ( isDigit )-import Data.Function.Selector ( Selector(..)- , chgS- , idS- , (.&&&.)- )-import qualified Data.Map as M+import Data.ByteString.Lazy (ByteString)+import Data.Char (isDigit)+import Data.Function.Selector (Selector (..), chgS, idS,+ (.&&&.))+import qualified Data.Map as M -import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.Interface -- ------------------------------------------------------------ {- datatypes -}@@ -62,8 +59,8 @@ -- state datatype consists of a system state and a user state -- the user state is not fixed -data XIOState us = XIOState { xioSysState :: ! XIOSysState- , xioUserState :: ! us+data XIOState us = XIOState { xioSysState :: ! XIOSysState+ , xioUserState :: ! us } instance (NFData us) => NFData (XIOState us) where@@ -155,102 +152,103 @@ -- predefined system state data type with all components for the -- system functions, like trace, error handling, ... -data XIOSysState = XIOSys { xioSysWriter :: ! XIOSysWriter- , xioSysEnv :: ! XIOSysEnv+data XIOSysState = XIOSys { xioSysWriter :: ! XIOSysWriter+ , xioSysEnv :: ! XIOSysEnv } -instance NFData XIOSysState -- all fields of interest are strict+instance NFData XIOSysState where+ rnf x = seq x () -- all fields of interest are strict -data XIOSysWriter = XIOwrt { xioErrorStatus :: ! Int- , xioErrorMsgList :: ! XmlTrees- , xioExpatErrors :: IOSArrow XmlTree XmlTree- , xioRelaxNoOfErrors :: ! Int- , xioRelaxDefineId :: ! Int- , xioRelaxAttrList :: AssocList String XmlTrees+data XIOSysWriter = XIOwrt { xioErrorStatus :: ! Int+ , xioErrorMsgList :: ! XmlTrees+ , xioExpatErrors :: IOSArrow XmlTree XmlTree+ , xioRelaxNoOfErrors :: ! Int+ , xioRelaxDefineId :: ! Int+ , xioRelaxAttrList :: AssocList String XmlTrees } -data XIOSysEnv = XIOEnv { xioTraceLevel :: ! Int- , xioTraceCmd :: Int -> String -> IO ()- , xioErrorMsgHandler :: String -> IO ()- , xioErrorMsgCollect :: ! Bool- , xioBaseURI :: ! String- , xioDefaultBaseURI :: ! String- , xioAttrList :: ! Attributes- , xioInputConfig :: ! XIOInputConfig- , xioParseConfig :: ! XIOParseConfig- , xioOutputConfig :: ! XIOOutputConfig- , xioRelaxConfig :: ! XIORelaxConfig- , xioXmlSchemaConfig :: ! XIOXmlSchemaConfig- , xioCacheConfig :: ! XIOCacheConfig+data XIOSysEnv = XIOEnv { xioTraceLevel :: ! Int+ , xioTraceCmd :: Int -> String -> IO ()+ , xioErrorMsgHandler :: String -> IO ()+ , xioErrorMsgCollect :: ! Bool+ , xioBaseURI :: ! String+ , xioDefaultBaseURI :: ! String+ , xioAttrList :: ! Attributes+ , xioInputConfig :: ! XIOInputConfig+ , xioParseConfig :: ! XIOParseConfig+ , xioOutputConfig :: ! XIOOutputConfig+ , xioRelaxConfig :: ! XIORelaxConfig+ , xioXmlSchemaConfig :: ! XIOXmlSchemaConfig+ , xioCacheConfig :: ! XIOCacheConfig } -data XIOInputConfig = XIOIcgf { xioStrictInput :: ! Bool- , xioEncodingErrors :: ! Bool- , xioInputEncoding :: String- , xioHttpHandler :: IOSArrow XmlTree XmlTree- , xioInputOptions :: ! Attributes- , xioRedirect :: ! Bool- , xioProxy :: String+data XIOInputConfig = XIOIcgf { xioStrictInput :: ! Bool+ , xioEncodingErrors :: ! Bool+ , xioInputEncoding :: String+ , xioHttpHandler :: IOSArrow XmlTree XmlTree+ , xioInputOptions :: ! Attributes+ , xioRedirect :: ! Bool+ , xioProxy :: String } -data XIOParseConfig = XIOPcfg { xioMimeTypes :: MimeTypeTable- , xioMimeTypeHandlers :: MimeTypeHandlers- , xioMimeTypeFile :: String- , xioAcceptedMimeTypes :: [String]- , xioFileMimeType :: String- , xioWarnings :: ! Bool- , xioRemoveWS :: ! Bool- , xioParseByMimeType :: ! Bool- , xioParseHTML :: ! Bool- , xioLowerCaseNames :: ! Bool- , xioPreserveComment :: ! Bool- , xioValidate :: ! Bool- , xioSubstDTDEntities :: ! Bool- , xioSubstHTMLEntities :: ! Bool- , xioCheckNamespaces :: ! Bool- , xioCanonicalize :: ! Bool- , xioIgnoreNoneXmlContents :: ! Bool- , xioTagSoup :: ! Bool- , xioTagSoupParser :: IOSArrow XmlTree XmlTree- , xioExpat :: ! Bool- , xioExpatParser :: IOSArrow XmlTree XmlTree+data XIOParseConfig = XIOPcfg { xioMimeTypes :: MimeTypeTable+ , xioMimeTypeHandlers :: MimeTypeHandlers+ , xioMimeTypeFile :: String+ , xioAcceptedMimeTypes :: [String]+ , xioFileMimeType :: String+ , xioWarnings :: ! Bool+ , xioRemoveWS :: ! Bool+ , xioParseByMimeType :: ! Bool+ , xioParseHTML :: ! Bool+ , xioLowerCaseNames :: ! Bool+ , xioPreserveComment :: ! Bool+ , xioValidate :: ! Bool+ , xioSubstDTDEntities :: ! Bool+ , xioSubstHTMLEntities :: ! Bool+ , xioCheckNamespaces :: ! Bool+ , xioCanonicalize :: ! Bool+ , xioIgnoreNoneXmlContents :: ! Bool+ , xioTagSoup :: ! Bool+ , xioTagSoupParser :: IOSArrow XmlTree XmlTree+ , xioExpat :: ! Bool+ , xioExpatParser :: IOSArrow XmlTree XmlTree } -data XIOOutputConfig = XIOOcfg { xioIndent :: ! Bool- , xioOutputEncoding :: ! String- , xioOutputFmt :: ! XIOXoutConfig- , xioXmlPi :: ! Bool- , xioNoEmptyElemFor :: ! [String]- , xioAddDefaultDTD :: ! Bool- , xioTextMode :: ! Bool- , xioShowTree :: ! Bool- , xioShowHaskell :: ! Bool+data XIOOutputConfig = XIOOcfg { xioIndent :: ! Bool+ , xioOutputEncoding :: ! String+ , xioOutputFmt :: ! XIOXoutConfig+ , xioXmlPi :: ! Bool+ , xioNoEmptyElemFor :: ! [String]+ , xioAddDefaultDTD :: ! Bool+ , xioTextMode :: ! Bool+ , xioShowTree :: ! Bool+ , xioShowHaskell :: ! Bool } data XIOXoutConfig = XMLoutput | XHTMLoutput | HTMLoutput | PLAINoutput deriving (Eq) -data XIORelaxConfig = XIORxc { xioRelaxValidate :: ! Bool- , xioRelaxSchema :: String- , xioRelaxCheckRestr :: ! Bool- , xioRelaxValidateExtRef :: ! Bool- , xioRelaxValidateInclude :: ! Bool- , xioRelaxCollectErrors :: ! Bool- , xioRelaxValidator :: IOSArrow XmlTree XmlTree+data XIORelaxConfig = XIORxc { xioRelaxValidate :: ! Bool+ , xioRelaxSchema :: String+ , xioRelaxCheckRestr :: ! Bool+ , xioRelaxValidateExtRef :: ! Bool+ , xioRelaxValidateInclude :: ! Bool+ , xioRelaxCollectErrors :: ! Bool+ , xioRelaxValidator :: IOSArrow XmlTree XmlTree } -data XIOXmlSchemaConfig = XIOScc { xioXmlSchemaValidate :: ! Bool- , xioXmlSchemaSchema :: String- , xioXmlSchemaValidator :: IOSArrow XmlTree XmlTree+data XIOXmlSchemaConfig = XIOScc { xioXmlSchemaValidate :: ! Bool+ , xioXmlSchemaSchema :: String+ , xioXmlSchemaValidator :: IOSArrow XmlTree XmlTree } -data XIOCacheConfig = XIOCch { xioBinaryCompression :: CompressionFct- , xioBinaryDeCompression :: DeCompressionFct- , xioWithCache :: ! Bool- , xioCacheDir :: ! String- , xioDocumentAge :: ! Int- , xioCache404Err :: ! Bool- , xioCacheRead :: String -> IOSArrow XmlTree XmlTree- , xioStrictDeserialize :: ! Bool+data XIOCacheConfig = XIOCch { xioBinaryCompression :: CompressionFct+ , xioBinaryDeCompression :: DeCompressionFct+ , xioWithCache :: ! Bool+ , xioCacheDir :: ! String+ , xioDocumentAge :: ! Int+ , xioCache404Err :: ! Bool+ , xioCacheRead :: String -> IOSArrow XmlTree XmlTree+ , xioStrictDeserialize :: ! Bool } type MimeTypeHandlers = M.Map String (IOSArrow XmlTree XmlTree)
src/Text/XML/HXT/DOM/QualifiedName.hs view
@@ -82,30 +82,27 @@ import Debug.Trace -} -import Control.Arrow ( (***) )+import Control.Arrow ((***)) import Control.DeepSeq import Control.FlatSeq import Data.AssocList import Data.Binary-import Data.Char ( toLower )+import Data.Char (toLower) import Data.IORef-import Data.List ( isPrefixOf )-import qualified Data.Map as M+import Data.List (isPrefixOf)+import qualified Data.Map as M import Data.Typeable -import System.IO.Unsafe ( unsafePerformIO )+import System.IO.Unsafe (unsafePerformIO) -import Text.XML.HXT.DOM.XmlKeywords ( a_xml- , a_xmlns- , xmlNamespace- , xmlnsNamespace- )+import Text.XML.HXT.DOM.XmlKeywords (a_xml, a_xmlns,+ xmlNamespace,+ xmlnsNamespace) -import Data.Char.Properties.XMLCharProps ( isXmlNCNameStartChar- , isXmlNCNameChar- )+import Data.Char.Properties.XMLCharProps (isXmlNCNameChar,+ isXmlNCNameStartChar) -- ----------------------------------------------------------------------------- @@ -113,8 +110,8 @@ -- Names are always reduced to normal form, and they are stored internally in a name cache -- for sharing equal names by the same data structure -data XName = XN { _idXN :: ! Int -- for optimization of equality test, see Eq instance- , unXN :: String+data XName = XN { _idXN :: ! Int -- for optimization of equality test, see Eq instance+ , unXN :: String } deriving (Typeable) @@ -161,9 +158,9 @@ -- When dealing with namespaces, the document tree must be processed by 'Text.XML.HXT.Arrow.Namespace.propagateNamespaces' -- to split names of structure \"prefix:localPart\" and label the name with the apropriate namespace uri -data QName = QN { localPart' :: ! XName- , namePrefix' :: ! XName- , namespaceUri' :: ! XName+data QName = QN { localPart' :: ! XName+ , namePrefix' :: ! XName+ , namespaceUri' :: ! XName } deriving (Typeable) @@ -188,11 +185,13 @@ | otherwise -- namespace aware cmp: ns is significant, px is irrelevant = compare (lp1, ns1) (lp2, ns2) -instance NFData QName+instance NFData QName where+ rnf x = seq x ()+ instance WNFData QName instance Show QName where- show = showQN+ show = showQN -- ----------------------------------------------------------------------------- @@ -508,9 +507,9 @@ -- the name and string cache -data NameCache = NC { _newXN :: ! Int -- next free name id- , _xnCache :: ! (M.Map String XName)- , _qnCache :: ! (M.Map (XName, XName, XName) QName) -- we need another type than QName+data NameCache = NC { _newXN :: ! Int -- next free name id+ , _xnCache :: ! (M.Map String XName)+ , _qnCache :: ! (M.Map (XName, XName, XName) QName) -- we need another type than QName } -- for the key because of the unusable -- Eq instance of QName type ChangeNameCache r = NameCache -> (NameCache, r)@@ -563,12 +562,12 @@ changeNameCache :: NFData r => ChangeNameCache r -> r changeNameCache action = unsafePerformIO changeNameCache' where- action' c = - let r = action c - in + action' c =+ let r = action c+ in fst r `seq` r -- eval name cache to whnf- - changeNameCache' = ++ changeNameCache' = do -- putStrLn "modify cache" res <- atomicModifyIORef theNameCache action'
src/Text/XML/HXT/DOM/ShowXml.hs view
@@ -23,17 +23,15 @@ ) where -import Prelude hiding (showChar, showString)+import Prelude hiding (showChar, showString) -import Data.Maybe-import Data.Tree.Class-import Data.Tree.NTree.TypeDefs+import Data.Maybe+import Data.Tree.Class+import Data.Tree.NTree.TypeDefs -import Text.XML.HXT.DOM.TypeDefs -- XML Tree types-import Text.XML.HXT.DOM.XmlKeywords-import Text.XML.HXT.DOM.XmlNode ( mkDTDElem- , getDTDAttrl- )+import Text.XML.HXT.DOM.TypeDefs+import Text.XML.HXT.DOM.XmlKeywords+import Text.XML.HXT.DOM.XmlNode (getDTDAttrl, mkDTDElem) -- ----------------------------------------------------------------------------- --@@ -79,37 +77,37 @@ -- ------------------------------------------------------------ -showXmlTrees :: (String -> StringFct) -> (String -> StringFct) -> XmlTrees -> StringFct+showXmlTrees :: (String -> StringFct) -> (String -> StringFct) -> XmlTrees -> StringFct showXmlTrees cf af = showTrees where -- ------------------------------------------------------------ - showTrees :: XmlTrees -> StringFct- showTrees = foldr (.) id . map showXmlTree+ showTrees :: XmlTrees -> StringFct+ showTrees = foldr (.) id . map showXmlTree {-# INLINE showTrees #-} - showTrees' :: XmlTrees -> StringFct- showTrees' = foldr (\ x y -> x . showNL . y) id . map showXmlTree+ showTrees' :: XmlTrees -> StringFct+ showTrees' = foldr (\ x y -> x . showNL . y) id . map showXmlTree {-# INLINE showTrees' #-} -- ------------------------------------------------------------ showXmlTree :: XmlTree -> StringFct showXmlTree (NTree (XText s) _) -- common cases first- = cf s+ = cf s showXmlTree (NTree (XTag t al) [])- = showLt . showQName t . showTrees al . showSlash . showGt+ = showLt . showQName t . showTrees al . showSlash . showGt showXmlTree (NTree (XTag t al) cs)- = showLt . showQName t . showTrees al . showGt+ = showLt . showQName t . showTrees al . showGt . showTrees cs . showLt . showSlash . showQName t . showGt showXmlTree (NTree (XAttr an) cs)- = showBlank+ = showBlank . showQName an . showEq . showQuot@@ -117,22 +115,22 @@ . showQuot showXmlTree (NTree (XBlob b) _)- = cf . blobToString $ b+ = cf . blobToString $ b showXmlTree (NTree (XCharRef i) _)- = showString "&#" . showString (show i) . showChar ';'+ = showString "&#" . showString (show i) . showChar ';' showXmlTree (NTree (XEntityRef r) _)- = showString "&" . showString r . showChar ';'+ = showString "&" . showString r . showChar ';' showXmlTree (NTree (XCmt c) _)- = showString "<!--" . showString c . showString "-->"+ = showString "<!--" . showString c . showString "-->" showXmlTree (NTree (XCdata d) _)- = showString "<![CDATA[" . showString d . showString "]]>"+ = showString "<![CDATA[" . showString d . showString "]]>" showXmlTree (NTree (XPi n al) _)- = showString "<?"+ = showString "<?" . showQName n . (foldr (.) id . map showPiAttr) al . showString "?>"@@ -147,10 +145,10 @@ = showXmlTree a -- id showXmlTree (NTree (XDTD de al) cs)- = showXmlDTD de al cs+ = showXmlDTD de al cs showXmlTree (NTree (XError l e) _)- = showString "<!-- ERROR ("+ = showString "<!-- ERROR (" . shows l . showString "):\n" . showString e@@ -160,7 +158,7 @@ showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct - showXmlDTD DOCTYPE al cs = showString "<!DOCTYPE "+ showXmlDTD DOCTYPE al cs = showString "<!DOCTYPE " . showAttr a_name al . showExternalId al . showInternalDTD cs@@ -171,7 +169,7 @@ . showTrees' ds . showChar ']' - showXmlDTD ELEMENT al cs = showString "<!ELEMENT "+ showXmlDTD ELEMENT al cs = showString "<!ELEMENT " . showAttr a_name al . showBlank . showElemType (lookup1 a_type al) cs@@ -233,19 +231,19 @@ . showString k showXmlDTD NOTATION al _cs- = showString "<!NOTATION "+ = showString "<!NOTATION " . showAttr a_name al . showExternalId al . showString " >" - showXmlDTD PENTITY al cs = showEntity "% " al cs+ showXmlDTD PENTITY al cs = showEntity "% " al cs showXmlDTD ENTITY al cs = showEntity "" al cs showXmlDTD PEREF al _cs = showPEAttr al showXmlDTD CONDSECT _ (c1 : cs)- = showString "<![ "+ = showString "<![ " . showXmlTree c1 . showString " [\n" . showTrees cs@@ -263,8 +261,8 @@ -- ------------------------------------------------------------ - showEntity :: String -> Attributes -> XmlTrees -> StringFct- showEntity kind al cs = showString "<!ENTITY "+ showEntity :: String -> Attributes -> XmlTrees -> StringFct+ showEntity kind al cs = showString "<!ENTITY " . showString kind . showAttr a_name al . showExternalId al@@ -273,8 +271,8 @@ . showString " >" - showEntityValue :: XmlTrees -> StringFct- showEntityValue [] = id+ showEntityValue :: XmlTrees -> StringFct+ showEntityValue [] = id showEntityValue cs = showBlank . showQuot . af (xshow cs)@@ -282,11 +280,11 @@ -- ------------------------------------------------------------ - showContent :: XmlTree -> StringFct+ showContent :: XmlTree -> StringFct showContent (NTree (XDTD de al) cs)- = cont2String de+ = cont2String de where- cont2String :: DTDElem -> StringFct+ cont2String :: DTDElem -> StringFct cont2String NAME = showAttr a_name al cont2String PEREF = showPEAttr al cont2String CONTENT = showLpar@@ -303,11 +301,11 @@ ) . s2 - showContent n = showXmlTree n+ showContent n = showXmlTree n -- ------------------------------------------------------------ - showElemType :: String -> XmlTrees -> StringFct+ showElemType :: String -> XmlTrees -> StringFct showElemType t cs | t == v_pcdata = showLpar . showString v_pcdata . showRpar | t == v_mixed@@ -320,7 +318,7 @@ . showRpar . showAttr a_modifier al1 | t == v_mixed -- incorrect tree, e.g. after erronius pe substitution- = showLpar+ = showLpar . showRpar | t == v_children &&@@ -333,54 +331,54 @@ where [(NTree (XDTD CONTENT al1) cs1)] = cs - mixedContent :: Attributes -> StringFct+ mixedContent :: Attributes -> StringFct mixedContent l = showString " | " . showAttr a_name l . showPEAttr l - selAttrl (XDTD _ as) = as+ selAttrl (XDTD _ as) = as selAttrl (XText tex) = [(a_name, tex)] selAttrl _ = [] -- ------------------------------------------------------------ -showQName :: QName -> StringFct-showQName = qualifiedName'+showQName :: QName -> StringFct+showQName = qualifiedName' {-# INLINE showQName #-} -- ------------------------------------------------------------ -showQuoteString :: String -> StringFct-showQuoteString s = showQuot . showString s . showQuot+showQuoteString :: String -> StringFct+showQuoteString s = showQuot . showString s . showQuot -- ------------------------------------------------------------ -showAttr :: String -> Attributes -> StringFct-showAttr k al = showString (fromMaybe "" . lookup k $ al)+showAttr :: String -> Attributes -> StringFct+showAttr k al = showString (fromMaybe "" . lookup k $ al) -- ------------------------------------------------------------ -showPEAttr :: Attributes -> StringFct-showPEAttr al = showPE (lookup a_peref al)+showPEAttr :: Attributes -> StringFct+showPEAttr al = showPE (lookup a_peref al) where- showPE (Just pe) = showChar '%'+ showPE (Just pe) = showChar '%' . showString pe . showChar ';'- showPE Nothing = id+ showPE Nothing = id -- ------------------------------------------------------------ -showExternalId :: Attributes -> StringFct-showExternalId al = id2Str (lookup k_system al) (lookup k_public al)+showExternalId :: Attributes -> StringFct+showExternalId al = id2Str (lookup k_system al) (lookup k_public al) where- id2Str Nothing Nothing = id- id2Str (Just s) Nothing = showBlank+ id2Str Nothing Nothing = id+ id2Str (Just s) Nothing = showBlank . showString k_system . showBlank . showQuoteString s- id2Str Nothing (Just p) = showBlank+ id2Str Nothing (Just p) = showBlank . showString k_public . showBlank . showQuoteString p- id2Str (Just s) (Just p) = showBlank+ id2Str (Just s) (Just p) = showBlank . showString k_public . showBlank . showQuoteString p@@ -389,11 +387,11 @@ -- ------------------------------------------------------------ -showNData :: Attributes -> StringFct-showNData al = nd2Str (lookup k_ndata al)+showNData :: Attributes -> StringFct+showNData al = nd2Str (lookup k_ndata al) where- nd2Str Nothing = id- nd2Str (Just v) = showBlank+ nd2Str Nothing = id+ nd2Str (Just v) = showBlank . showString k_ndata . showBlank . showString v@@ -430,7 +428,7 @@ showNL = showChar '\n' {-# INLINE showNL #-} -showChar :: Char -> StringFct+showChar :: Char -> StringFct showChar = (:) {-# INLINE showChar #-}
src/Text/XML/HXT/DOM/TypeDefs.hs view
@@ -31,8 +31,8 @@ import Data.AssocList import Data.Binary-import qualified Data.ByteString.Lazy as BS-import qualified Data.ByteString.Lazy.Char8 as CS+import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy.Char8 as CS import Data.Tree.NTree.TypeDefs import Data.Tree.NTree.Zipper.TypeDefs@@ -126,7 +126,7 @@ put (XPi qn ts) = put ( 5::Word8) >> put qn >> put ts put (XDTD de al) = put ( 7::Word8) >> put de >> put al put (XError n e) = put ( 9::Word8) >> put n >> put e- put (XBlob b) = put (10::Word8) >> put b + put (XBlob b) = put (10::Word8) >> put b get = do tag <- getWord8@@ -194,13 +194,14 @@ deriving (Eq, Ord, Enum, Show, Read, Typeable) instance NFData DTDElem+ where rnf x = seq x ()+ instance WNFData DTDElem instance Binary DTDElem where- put de = put ((toEnum . fromEnum $ de)::Word8) -- DTDElem is not yet instance of Enum- get = do- tag <- getWord8- return $! (toEnum . fromEnum $ tag)+ put de = put ((toEnum . fromEnum $ de)::Word8) -- DTDElem is not yet instance of Enum+ get = do tag <- getWord8+ return $! (toEnum . fromEnum $ tag) -- ----------------------------------------------------------------------------- @@ -252,9 +253,9 @@ -- such that the selected nodes can be processed or selected later in -- processing a document tree -data XmlNodeSet = XNS { thisNode :: Bool -- ^ is this node part of the set ?- , attrNodes :: [QName] -- ^ the set of attribute nodes- , childNodes :: ChildNodes -- ^ the set of child nodes, a list of pairs of index and node set+data XmlNodeSet = XNS { thisNode :: Bool -- ^ is this node part of the set ?+ , attrNodes :: [QName] -- ^ the set of attribute nodes+ , childNodes :: ChildNodes -- ^ the set of child nodes, a list of pairs of index and node set } deriving (Eq, Show, Typeable)
src/Text/XML/HXT/DTDValidation/DTDValidation.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ -- ------------------------------------------------------------ {- |@@ -36,8 +38,8 @@ ) where -import Text.XML.HXT.DTDValidation.TypeDefs-import Text.XML.HXT.DTDValidation.AttributeValueValidation+import Text.XML.HXT.DTDValidation.AttributeValueValidation+import Text.XML.HXT.DTDValidation.TypeDefs -- | -- Validate a DTD.
src/Text/XML/HXT/DTDValidation/Validation.hs view
@@ -36,12 +36,12 @@ where -import Text.XML.HXT.DTDValidation.TypeDefs+import Text.XML.HXT.DTDValidation.TypeDefs -import qualified Text.XML.HXT.DTDValidation.DTDValidation as DTDValidation+import qualified Text.XML.HXT.DTDValidation.DocTransformation as DocTransformation import qualified Text.XML.HXT.DTDValidation.DocValidation as DocValidation+import qualified Text.XML.HXT.DTDValidation.DTDValidation as DTDValidation import qualified Text.XML.HXT.DTDValidation.IdValidation as IdValidation-import qualified Text.XML.HXT.DTDValidation.DocTransformation as DocTransformation -- | -- Main validation filter. Check if the DTD and the document are valid.@@ -127,8 +127,8 @@ >>> ( filterA $ isDTDDoctype >>> getDTDAttrl >>> isA (hasEntry a_name) ) -generalEntitiesDefined :: XmlArrow-generalEntitiesDefined = getDTDSubset+generalEntitiesDefined :: XmlArrow+generalEntitiesDefined = getDTDSubset >>> deep isDTDEntity
src/Text/XML/HXT/Parser/XmlCharParser.hs view
@@ -32,34 +32,32 @@ ) where -import Data.Char.Properties.XMLCharProps ( isXmlCharCR- , isXmlNameChar- , isXmlNameStartChar- , isXmlNCNameChar- , isXmlNCNameStartChar- , isXmlLetter- , isXmlSpaceCharCR- )+import Data.Char.Properties.XMLCharProps (isXmlCharCR, isXmlLetter,+ isXmlNCNameChar,+ isXmlNCNameStartChar,+ isXmlNameChar,+ isXmlNameStartChar,+ isXmlSpaceCharCR) -import Data.String.Unicode+import Data.String.Unicode -import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec -- ------------------------------------------------------------ -type XParser s a = GenParser Char (XPState s) a+type XParser s a = GenParser Char (XPState s) a type SimpleXParser a = XParser () a -data XPState s = XPState- { xps_normalizeNewline :: ! Bool- , xps_userState :: s+data XPState s = XPState+ { xps_normalizeNewline :: ! Bool+ , xps_userState :: s } -withNormNewline :: a -> XPState a-withNormNewline x = XPState True x+withNormNewline :: a -> XPState a+withNormNewline x = XPState True x -withoutNormNewline :: a -> XPState a-withoutNormNewline x = XPState False x+withoutNormNewline :: a -> XPState a+withoutNormNewline x = XPState False x -- ------------------------------------------------------------ --
src/Text/XML/HXT/Parser/XmlParsec.hs view
@@ -58,60 +58,39 @@ ) where -import Control.Applicative ( (<$>) )+import Control.Applicative ((<$>)) -import Text.ParserCombinators.Parsec ( runParser- , (<?>), (<|>)- , char- , string- , eof- , between- , many- , many1- , notFollowedBy- , option- , try- , unexpected- , getPosition- , getInput- , sourceName- )+import Text.ParserCombinators.Parsec (between, char, eof,+ getInput, getPosition,+ many, many1,+ notFollowedBy, option,+ runParser, sourceName,+ string, try, unexpected,+ (<?>), (<|>)) -import Text.XML.HXT.DOM.ShowXml ( xshow- )-import Text.XML.HXT.DOM.Interface-import Text.XML.HXT.DOM.XmlNode ( mkElement'- , mkAttr'- , mkRoot'- , mkDTDElem'- , mkText'- , mkCmt'- , mkCdata'- , mkError'- , mkPi'- , isText- , isRoot- , getText- , getChildren- , getAttrl- , getAttrName- , changeAttrl- , mergeAttrl- )-import Text.XML.HXT.Parser.XmlCharParser ( xmlChar- , XParser- , SimpleXParser- , XPState- , withNormNewline- , withoutNormNewline- )-import qualified Text.XML.HXT.Parser.XmlTokenParser as XT-import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD+import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.ShowXml (xshow)+import Text.XML.HXT.DOM.XmlNode (changeAttrl,+ getAttrName, getAttrl,+ getChildren, getText,+ isRoot, isText,+ mergeAttrl, mkAttr',+ mkCdata', mkCmt',+ mkDTDElem', mkElement',+ mkError', mkPi',+ mkRoot', mkText')+import Text.XML.HXT.Parser.XmlCharParser (SimpleXParser, XPState,+ XParser,+ withNormNewline,+ withoutNormNewline,+ xmlChar)+import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD+import qualified Text.XML.HXT.Parser.XmlTokenParser as XT -import Control.FlatSeq+import Control.FlatSeq -import Data.Char (toLower)-import Data.Maybe+import Data.Char (toLower)+import Data.Maybe -- import Debug.Trace @@ -193,7 +172,7 @@ -- the leading <! is already parsed, no try neccessary cDSect' :: XParser s XmlTree-cDSect' +cDSect' = cDSect'' (string "[CDATA[" >> return ()) cDSect'' :: XParser s () -> XParser s XmlTree@@ -467,14 +446,14 @@ content = XT.mergeTextNodes <$> many- ( ( do -- parse markup but no closing tags+ ( ( do -- parse markup but no closing tags try ( XT.lt >> notFollowedBy (char '/') >> return () )- markup+ markup ) <|> charData'@@ -483,17 +462,17 @@ ) where markup- = element'- <|>- pI'- <|>- ( char '!'+ = element'+ <|>+ pI'+ <|>+ ( char '!' >>- ( comment'- <|>- cDSect'+ ( comment'+ <|>+ cDSect' )- )+ ) contentWithTextDecl :: XParser s XmlTrees contentWithTextDecl