packages feed

hxt 8.3.1 → 8.3.2

raw patch · 27 files changed

+394/−127 lines, 27 filesdep ~parsec

Dependency ranges changed: parsec

Files

Version.mk view
@@ -2,6 +2,6 @@ # Version numbering for HXT  SOFTWARE	= hxt-VERSION		= 8.3.1-LASTVERSION	= 8.3.0+VERSION		= 8.3.2+LASTVERSION	= 8.3.1 DIST_NAME	= $(SOFTWARE)-$(VERSION)
doc/index.html view
@@ -1,12 +1,12 @@ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html>   <head>-    <title>Haskell XML Toolbox 8.3.1</title>+    <title>Haskell XML Toolbox 8.3.2</title>     <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">   </head>    <body style="background-color: #ffffff;">-    <h1>Haskell XML Toolbox 8.3.1</h1>+    <h1>Haskell XML Toolbox 8.3.2</h1>      <h3>Contents</h3>     <ul>@@ -185,8 +185,8 @@     <a name="down"></a>     <h3>Downloads</h3>     <p>-      <a href="hxt-8.3.1.tar.gz">Haskell XML Toolbox 8.3.1</a>,-      released 2009-06-16:+      <a href="hxt-8.3.2.tar.gz">Haskell XML Toolbox 8.3.2</a>,+      released 2009-10-29:     </p>     <ul>       <li>This version works with ghc 6.10 with cabal 1.6.@@ -225,7 +225,7 @@     <p>       Before installing this version, install the curl and tagsoup modules.       For a quick install with Cabal execute the following commands in-      <tt>.../HXT-8.3.1</tt>+      <tt>.../HXT-8.3.2</tt>     </p>     <pre>     cabal configure@@ -251,7 +251,41 @@     <a name="change"></a>     <h3>Change History</h3>     <ul>+      <li>In <a href="hxt-8.3.2.tar.gz">Version 8.3.2</a>+	This is a bug fix release.+	<ul>+	  <li>+	    New output option <tt>a_output_xhtml</tt>for writing XHTML.+	  </li>+	  <li>+	    New output option <tt>a_no_empty_elem_for</tt> for precise+	    control, which empty elements shall not be emitted in+	    short form <tt>&lt;name .../&gt;</tt>.+	  </li>+	  <li>New output option <tt>a_add_default_dtd</tt> for easy+	    adding a Document Type Declaration.+	  </li>+	  <li>+	    <tt>writeDocumentToString</tt> changed, such that it is a pure+	    arrow and does not need to run in the IO monad.+	  </li>+	  <li>+	    Dealing with URIs containing unescaped chars changed.+	    When URIs can't be parsed (with Network.URI), then the+	    not allowed chars will be escaped in %XX format and+	    URI parsing is retried. This enables normal file names to contain blanks and+	    other chars without explicit escaping.+	  </li>+	</ul>+      </li>       <li>In <a href="hxt-8.3.1.tar.gz">Version 8.3.1</a>+	<ul>+	  <li> Additional input option "a_accept_mimetypes" for setting a list of allowed+	    mime types when using readDocument.+	  </li>+	</ul>+      </li>+      <li>In <a href="hxt-8.3.1.tar.gz">Version 8.3.1</a> 	This is only a bug fix release. 	<ul> 	  <li>@@ -605,7 +639,7 @@ 	    </a> 	  </td> 	</tr>-	<tr><td><i>Last modified: 2009-06-16</i></td><td>&nbsp;</td></tr>+	<tr><td><i>Last modified: 2009-10-29</i></td><td>&nbsp;</td></tr>     </table>    </body>
examples/arrows/RegexXMLSchema/REtest.hs view
@@ -137,7 +137,7 @@ -- ----------------------------------------  -- output is done with low level ops to write the--- document i a lasy manner+-- document i a lazy manner -- adding an xml pi and encoding is done "by hand" -- latin1 decoding is the identity, so please generate the -- docs with latin1 encoding. Here ist done even with ASCCI
examples/arrows/RelaxTestSuite/ReadDir.hs view
@@ -19,6 +19,7 @@   ) import Data.List   ( find+  , sort   , isSuffixOf   ) import Maybe@@ -46,7 +47,7 @@ readDir pre p   = do      dir     <- getDirectoryContents $ pre ++ "/" ++ p-    entries <- getEntries $ clean [".", "..", "CVS"] dir+    entries <- getEntries $ sort $ clean [".", "..", "CVS"] dir     return $ Dir entries   where   getEntries :: [FilePath] -> IO [Entry]
examples/arrows/hparser/Makefile view
@@ -107,7 +107,7 @@ 		cat $(EX4) 		@sleep 2 ; echo ; echo "===> parser accepts this document and tries to build a document tree" ; echo ; sleep 2 		$(prog) --indent --preserve-comment --parse-html $(EX4)-		@sleep 2 ; echo ; echo "===> same with lasy parser with tagsoup" ; echo ; sleep 2+		@sleep 2 ; echo ; echo "===> same with lazy parser with tagsoup" ; echo ; sleep 2 		$(prog) -H -T -r --indent $(EX4) 		@echo 		@echo "===> the source of another lousy html document containing empty elements" ; echo ; sleep 2
+ examples/arrows/hrelaxng/valid2a.xml view
examples/arrows/performance/GenDoc.hs view
@@ -70,7 +70,7 @@  -- ---------------------------------------- --- test on lasyness, is the whole tree read or only the first child of every child node?+-- test on lazyness, is the whole tree read or only the first child of every child node?  main3	:: Bool -> Int -> IO () main3 l i@@ -243,7 +243,7 @@ -- ----------------------------------------  -- output is done with low level ops to write the--- document i a lasy manner+-- document i a lazy manner -- adding an xml pi and encoding is done "by hand" -- latin1 decoding is the identity, so please generate the -- docs with latin1 encoding. Here ist done even with ASCCI
hxt.cabal view
@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file name: hxt-version: 8.3.1+version: 8.3.2 license: OtherLicense license-file: LICENCE maintainer: Uwe Schmidt <uwe@fh-wedel.de>@@ -134,7 +134,7 @@                 containers >= 0.1 && < 1,                 directory  >= 1 && < 2,                 filepath   >= 1 && < 2,-                parsec     >= 2.1 && < 3,+                parsec     >= 2.1 && < 4,                 HUnit      >= 1.2 && < 2,                 network    >= 2.1 && < 3,                 parallel   >= 1.0 && < 2,
src/Control/Arrow/ArrowTree.hs view
@@ -122,7 +122,7 @@     -- all \"h1\" elements in the \"body\" element of an \"html\" element, an expression, that     -- corresponds 1-1 to the XPath selection path \"html\/body\/h1\"  -    (/>)		:: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)+    (/>)		:: Tree t => a b (t c) -> a (t c) d -> a b d     f /> g		= f >>> getChildren >>> g      -- |@@ -138,7 +138,7 @@     -- to the XPath selection path \"html\/\/table\". The latter on matches all table elements     -- even nested ones, but @\/\/>@ gives in many cases the appropriate functionality. -    (//>)		:: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)+    (//>)		:: Tree t => a b (t c) -> a (t c) d -> a b d     f //> g		= f >>> getChildren >>> deep g  @@ -159,7 +159,7 @@     -- example: @ deep isHtmlTable @ selects all top level table elements in a document     -- (with an appropriate definition for isHtmlTable) but no tables occuring within a table cell. -    deep		:: Tree t => a (t b) (t b) -> a (t b) (t b)+    deep		:: Tree t => a (t b) c -> a (t b) c     deep f		= f					-- success when applying f 			  `orElse` 			  (getChildren >>> deep f)		-- seach children@@ -171,7 +171,7 @@     -- example: @ deepest isHtmlTable @ selects all innermost table elements in a document     -- but no table elements containing tables. See 'deep' and 'multi' for other search strategies. -    deepest		:: Tree t => a (t b) (t b) -> a (t b) (t b)+    deepest		:: Tree t => a (t b) c -> a (t b) c     deepest f		= (getChildren >>> deepest f)		-- seach children 			  `orElse` 			  f					-- no success: apply f to root
src/Makefile view
@@ -268,7 +268,7 @@  install_packages	: 		runghc hxt-package.hs $(VERSION) "ghc" $(GHC_INSTALL_DIR) $(HXT_SRC) \-		| ghc-pkg --update-package+		| ghc-pkg update -  uninstall_packages	: 		ghc-pkg --remove-package $(HXT_PACKAGE) || true
src/Text/XML/HXT/Arrow/DocumentInput.hs view
@@ -20,6 +20,7 @@     , getXmlContents     , getXmlEntityContents     , getEncoding+    , getTextEncoding     , decodeDocument     ) where
src/Text/XML/HXT/Arrow/DocumentOutput.hs view
@@ -16,7 +16,12 @@ -- ------------------------------------------------------------  module Text.XML.HXT.Arrow.DocumentOutput-    ( module Text.XML.HXT.Arrow.DocumentOutput )+    ( putXmlDocument+    , putXmlTree+    , putXmlSource+    , encodeDocument+    , encodeDocument'+    ) where  import Control.Arrow				-- arrow classes@@ -24,11 +29,13 @@ import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree import Control.Arrow.ArrowIO+import Control.Arrow.ListArrow  import Text.XML.HXT.DOM.Unicode     ( getOutputEncodingFct )  import Text.XML.HXT.DOM.Interface+ import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow @@ -125,8 +132,39 @@  -- ------------------------------------------------------------ +getEncodingParam	:: IOStateArrow s XmlTree String+getEncodingParam+    = catA [ getParamString a_output_encoding	-- 4. guess: take output encoding parameter from global state+	   , getParamString a_encoding		-- 5. guess: take encoding parameter from global state+	   , constA utf8			-- default : utf8+           ]+      >. (head . filter (not . null))+ getOutputEncoding	:: String -> IOStateArrow s XmlTree String getOutputEncoding defaultEnc+    = getEC $< getEncodingParam+    where+    getEC enc' = fromLA $ getOutputEncoding' defaultEnc enc'++encodeDocument	:: Bool -> String -> IOStateArrow s XmlTree XmlTree+encodeDocument supressXmlPi defaultEnc+    = encode $< getOutputEncoding defaultEnc+    where+    encode enc+        = traceMsg 2 ("encodeDocument: encoding is " ++ show enc)+	  >>>+          ( encodeDocument' supressXmlPi enc+            `orElse`+            ( issueFatal ("encoding scheme not supported: " ++ show enc)+	      >>>+	      setDocumentStatusFromSystemState "encoding document"+            )+          )++-- ------------------------------------------------------------++getOutputEncoding'	:: String -> String -> LA XmlTree String+getOutputEncoding' defaultEnc defaultEnc2     =  catA [ getChildren			-- 1. guess: evaluate <?xml ... encoding="..."?> 	      >>> 	      ( ( isPi >>> hasName t_xml )@@ -135,45 +173,33 @@ 	      ) 	    , constA defaultEnc			-- 2. guess: explicit parameter, may be "" 	    , getAttrValue a_output_encoding	-- 3. guess: take output encoding parameter in root node-	    , getParamString a_output_encoding	-- 4. guess: take output encoding parameter in global state-	    , getParamString a_encoding		-- 5. guess: take encoding parameter in global state-	    , constA utf8			-- default : utf8+	    , constA defaultEnc2		-- default : UNICODE or utf8 	    ]       >. (head . filter (not . null))		-- make the filter deterministic: take 1. entry from list of guesses -encodeDocument	:: Bool -> String -> IOStateArrow s XmlTree XmlTree-encodeDocument supressXmlPi defaultEnc-    = applyA ( getOutputEncoding defaultEnc-	       >>>-	       arr encArr-	     )-      `when`-      isRoot+encodeDocument'	:: ArrowXml a => Bool -> String -> a XmlTree XmlTree+encodeDocument' supressXmlPi defaultEnc+    = fromLA (encode $< getOutputEncoding' defaultEnc utf8)     where-    encArr	:: String -> IOStateArrow s XmlTree XmlTree-    encArr enc	= maybe notFound found . getOutputEncodingFct $ enc-	where-	found ef = traceMsg 2 ("encodeDocument: encoding is " ++ show enc)-		   >>>-		   ( if supressXmlPi-		     then processChildren (none `when` isXmlPi)-		     else ( addXmlPi-			    >>>-			    addXmlPiEncoding enc-			  )-		   )-		   >>>-		   replaceChildren ( xshow getChildren-				     >>>-				     arr ef-				     >>>-				     mkText-				   )-		   >>>-		   addAttr a_output_encoding enc--	notFound = issueFatal ("encoding scheme not supported: " ++ show enc)-		   >>>-		   setDocumentStatusFromSystemState "encoding document"+    encode	:: String -> LA XmlTree XmlTree+    encode encodingScheme+        = case getOutputEncodingFct encodingScheme of+          Nothing	-> none+          Just ef	-> ( if supressXmlPi+		             then processChildren (none `when` isXmlPi)+		             else ( addXmlPi+			            >>>+			            addXmlPiEncoding encodingScheme+			          )+		           )+		           >>>+		           replaceChildren ( xshow getChildren+				             >>>+				             arr ef+				             >>>+				             mkText+				           )+		           >>>+		           addAttr a_output_encoding encodingScheme  -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/Edit.hs view
@@ -46,6 +46,9 @@     , transfCharRef     , transfAllCharRef +    , rememberDTDAttrl+    , addDefaultDTDecl+     , hasXmlPi     , addXmlPi     , addXmlPiEncoding@@ -72,6 +75,7 @@ import           Text.XML.HXT.Parser.XmlEntities	( xmlEntities ) import           Text.XML.HXT.Parser.XhtmlEntities	( xhtmlEntities ) +import           Data.List                              ( isPrefixOf ) import qualified Data.Map 			as M import           Data.Maybe @@ -357,11 +361,12 @@  -- ------------------------------------------------------------ -preventEmptyElements	:: ArrowList a => Bool -> a XmlTree XmlTree-preventEmptyElements isHtml+preventEmptyElements	:: ArrowList a => [String] -> Bool -> a XmlTree XmlTree+preventEmptyElements ns isHtml     = fromLA $ insertDummyElem     where     isNoneEmpty+        | not (null ns) = hasNameWith (localPart >>> (`elem` ns)) 	| isHtml	= hasNameWith (localPart >>> (`notElem` emptyHtmlTags)) 	| otherwise	= this @@ -704,6 +709,39 @@ transfAllCharRef	:: ArrowXml a => a XmlTree XmlTree transfAllCharRef	= fromLA $ 			  processBottomUp transfCharRef'++-- ------------------------------------------------------------++rememberDTDAttrl	:: ArrowList a => a XmlTree XmlTree+rememberDTDAttrl+    = fromLA $+      ( ( addDTDAttrl $< ( getChildren >>> isDTDDoctype >>> getDTDAttrl ) )+        `orElse`+        this+      )+    where+    addDTDAttrl al+        = seqA . map (uncurry addAttr) . map (first (dtdPrefix ++)) $ al++addDefaultDTDecl	:: ArrowList a => a XmlTree XmlTree+addDefaultDTDecl+    = fromLA $+      ( addDTD $< listA (getAttrl >>> (getName &&& xshow getChildren) >>> hasDtdPrefix) )+    where+    hasDtdPrefix+        = isA (fst >>> (dtdPrefix `isPrefixOf`))+          >>>+          arr (first (drop (length dtdPrefix)))+    addDTD []+        = this+    addDTD al+        = replaceChildren+          ( mkDTDDoctype al none+            <+>+            txt "\n"+            <+>+            ( getChildren >>> (none `when` isDTDDoctype) )	-- remove old DTD stuff+          )  -- ------------------------------------------------------------ 
src/Text/XML/HXT/Arrow/ReadDocument.hs view
@@ -36,6 +36,7 @@ import Text.XML.HXT.Arrow.Edit			( canonicalizeAllNodes 						, canonicalizeForXPath 						, canonicalizeContents+                                                , rememberDTDAttrl 						, removeDocWhiteSpace 						) @@ -60,7 +61,7 @@  * 'a_parse_html': use HTML parser, else use XML parser (default) -- 'a_tagsoup' : use light weight and lasy parser based on tagsoup lib+- 'a_tagsoup' : use light weight and lazy parser based on tagsoup lib  - 'a_parse_by_mimetype' : select the parser by the mime type of the document                           (pulled out of the HTTP header). When the mime type is set to \"text\/html\"@@ -210,6 +211,7 @@ 	  , ( a_parse_by_mimetype,	  v_0 ) 	  , ( a_ignore_encoding_errors,   v_0 ) 	  , ( a_ignore_none_xml_contents, v_0 )+	  , ( a_accept_mimetypes,         ""  ) 	  ]      traceLevel@@ -229,22 +231,54 @@ 	= getAttrValue transferMimeType >>^ stringToLower      processDoc mimeType-	= traceMsg 1 ("readDocument: " ++ show src ++ " (mime type: " ++ show mimeType ++ ") will be processed")-	  >>>-	  parse+	= traceMsg 1 (unwords [ "readDocument:", show src+			      , "(mime type:", show mimeType, ") will be processed"]) 	  >>>-	  ( if isXmlOrHtml-	    then ( checknamespaces-		   >>>-		   canonicalize-		   >>>-		   whitespace+	  ( if isAcceptedMimeType (lookup1 a_accept_mimetypes options) mimeType+	    then ( parse 		   >>>-		   relax+		   ( if isXmlOrHtml+		     then ( checknamespaces+			    >>>+                            rememberDTDAttrl+                            >>>+			    canonicalize+			    >>>+			    whitespace+			    >>>+			    relax+			  )+		     else this+		   ) 		 )-	    else this+	    else ( traceMsg 1 (unwords [ "readDocument:", show src+				       , "mime type:", show mimeType, "not accepted"])+		   >>>+		   replaceChildren none+		 )								-- remove contents of not accepted mimetype 	  ) 	where+	isAcceptedMimeType		:: String -> String -> Bool+	isAcceptedMimeType mts mt+	    | null mts+	      ||+	      null mt			= True+	    | otherwise			= foldr (matchMt mt') False $ mts'+	    where+	    mt'				= parseMt mt+	    mts'			= words+					  >>>+					  map parseMt+					  $+					  mts+	    parseMt			= break (== '/')+					  >>>+					  second (drop 1)+	    matchMt (ma,mi) (mas,mis) r	= ( (ma == mas || mas == "*")+					    &&+					    (mi == mis || mis == "*")+					  )+					  || r 	parse 	    | isHtml 	      || @@ -257,7 +291,7 @@ 					  isHtml 	    | validateWithRelax		= parseXmlDocument False		-- for Relax NG use XML parser without validation 	    | isXml			= parseXmlDocument validate		-- parse as XML-	    | removeNoneXml		= replaceChildren none			-- don't parse, if mime type is not XML nore HTML+	    | removeNoneXml		= replaceChildren none			-- don't parse, if mime type is not XML nor HTML 	    | otherwise			= this					-- but remove contents when option is set 	checknamespaces 	    | (withNamespaces && not withTagSoup)@@ -313,7 +347,7 @@  readFromDocument	:: Attributes -> IOStateArrow s String XmlTree readFromDocument userOptions-    = applyA ( arr $ \ s -> readDocument userOptions s )+    = applyA ( arr $ readDocument userOptions )  -- ------------------------------------------------------------ @@ -336,7 +370,7 @@  readFromString	:: Attributes -> IOStateArrow s String XmlTree readFromString userOptions-    = applyA ( arr $ \ s -> readString userOptions s )+    = applyA ( arr $ readString userOptions )  -- ------------------------------------------------------------ 
src/Text/XML/HXT/Arrow/WriteDocument.hs view
@@ -35,6 +35,7 @@ 						, escapeXmlDoc 						, haskellRepOfXmlDoc 						, indentDoc+                                                , addDefaultDTDecl 						, preventEmptyElements 						, removeDocWhiteSpace 						, treeRepOfXmlDoc@@ -42,6 +43,7 @@  import Text.XML.HXT.Arrow.DocumentOutput	( putXmlDocument 						, encodeDocument+						, encodeDocument' 						)  -- ------------------------------------------------------------@@ -76,6 +78,12 @@                           Empty script elements, like \<script href=\"...\"/\>, are always a problem for firefox and others.                           When XML output is generated with this option, all empty elements are written in the long form. +- 'a_no_empty_elem_for' : do not generate empty elements for the element names given in the comma separated list of this option value.+                          This option overwrites the above described 'a_no_empty_elements' option++- 'a_add_default_dtd' : if the document to be written was build by reading another document containing a Document Type Declaration,+                        this DTD is inserted into the output document (default: no insert)+ - 'a_no_xml_pi' : suppress generation of \<?xml ... ?\> processing instruction  - 'a_show_tree' : show tree representation of document (for debugging)@@ -129,7 +137,7 @@ writeDocument userOptions dst     = perform ( traceMsg 1 ("writeDocument: destination is " ++ show dst) 		>>>-		prepareContents userOptions+		prepareContents userOptions encodeDocument 		>>> 		putXmlDocument dst 		>>>@@ -142,11 +150,24 @@  -- | -- Convert a document into a string. Formating is done the same way--- and with the same options as in 'writeDocument'.+-- and with the same options as in 'writeDocument'. Default output encoding is+-- no encoding, that means the result is a normal unicode encode haskell string.+-- The default may be overwritten with the 'Text.XML.HXT.XmlKeywords.a_output_encoding' option.+-- The XML PI can be suppressed by the 'Text.XML.HXT.XmlKeywords.a_no_xml_pi' option.+--+-- This arrow fails, when the encoding scheme is not supported.+-- The arrow is pure, it does not run in the IO monad.+-- The XML PI is suppressed, if not explicitly turned on with an+-- option @ (a_no_xml_pi, v_0) @ -writeDocumentToString	:: Attributes  ->  IOStateArrow s XmlTree String+writeDocumentToString	:: ArrowXml a => Attributes  -> a XmlTree String writeDocumentToString userOptions-    = prepareContents userOptions+    = prepareContents ( addEntries+                        userOptions+                        [ (a_output_encoding, unicodeString)+                        , (a_no_xml_pi, v_1)+                        ]+                      ) encodeDocument'       >>>       xshow getChildren @@ -155,15 +176,23 @@ -- | -- indent and format output -prepareContents	:: Attributes -> IOStateArrow s XmlTree XmlTree-prepareContents userOptions+prepareContents	:: ArrowXml a => Attributes -> (Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree+prepareContents userOptions encodeDoc     = indent       >>>+      addDtd+      >>>       format     where     formatEmptyElems-	| hasOption a_no_empty_elements = preventEmptyElements+        | not (null noEmptyElemFor)     = preventEmptyElements noEmptyElemFor+	| hasOption a_no_empty_elements+          ||+          hasOption a_output_xhtml      = preventEmptyElements [] 	| otherwise                     = const this+    addDtd+        | hasOption a_add_default_dtd   = addDefaultDTDecl+        | otherwise                     = this     indent 	| hasOption a_indent		= indentDoc			-- document indentation 	| hasOption a_remove_whitespace	= removeDocWhiteSpace		-- remove all whitespace between tags@@ -176,19 +205,25 @@ 					  >>> 					  escapeHtmlDoc			-- escape al XML and HTML chars >= 128 					  >>>-					  encodeDocument		-- convert doc into text with respect to output encoding with ASCII as default+					  encodeDoc			-- convert doc into text with respect to output encoding with ASCII as default 					    suppressXmlPi ( lookupDef usAscii a_output_encoding options )-	| hasOption a_output_xml	= formatEmptyElems False+	| hasOption a_output_xml	= formatEmptyElems (hasOption a_output_xhtml) 					  >>> 					  escapeXmlDoc			-- escape lt, gt, amp, quot,  					  >>>-					  encodeDocument		-- convert doc into text with respect to output encoding+					  encodeDoc			-- convert doc into text with respect to output encoding 					    suppressXmlPi ( lookupDef "" a_output_encoding options ) 	| otherwise			= this      suppressXmlPi							-- remove <?xml ... ?> when set 	= hasOption a_no_xml_pi +    noEmptyElemFor+        = words+          . map (\ c -> if c == ',' then ' ' else c)+          . lookup1 a_no_empty_elem_for+          $ options+     hasOption n 	= optionIsSet n options @@ -200,8 +235,11 @@ 	      , ( a_show_tree,		v_0 ) 	      , ( a_show_haskell,	v_0 ) 	      , ( a_output_html,	v_0 )+	      , ( a_output_xhtml,	v_0 ) 	      , ( a_no_xml_pi,          v_0 ) 	      , ( a_no_empty_elements,  v_0 )+              , ( a_no_empty_elem_for,  ""  )+              , ( a_add_default_dtd,    v_0 ) 	      ]  -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/XmlArrow.hs view
@@ -479,7 +479,7 @@     setAttrl		:: a XmlTree XmlTree -> a XmlTree XmlTree     setAttrl		= changeAttrl (const id) 		-- (\ x y -> y) -    -- | add a list of attributes list to an element+    -- | add a list of attributes to an element     addAttrl		:: a XmlTree XmlTree -> a XmlTree XmlTree     addAttrl		= changeAttrl (XN.mergeAttrl) 
src/Text/XML/HXT/Arrow/XmlIOStateArrow.hs view
@@ -134,6 +134,7 @@ import Control.Arrow.ArrowIO import Control.Arrow.IOStateListArrow +import Control.Monad				( mplus ) import Control.Parallel.Strategies  import Text.XML.HXT.DOM.Interface@@ -850,13 +851,24 @@  -- ---------------------------------------------------------- +-- | parse a URI reference, in case of a failure try to escape special chars+-- and try parsing again++parseURIReference'	:: String -> Maybe URI+parseURIReference' uri+    = parseURIReference uri+      `mplus`+      parseURIReference uri'+    where+    uri' = concatMap ( escapeURIChar isUnescapedInURI) uri+ -- | compute the absolut URI for a given URI and a base URI  expandURIString	:: String -> String -> Maybe String expandURIString uri base     = do-      base' <- parseURIReference base-      uri'  <- parseURIReference uri+      base' <- parseURIReference' base+      uri'  <- parseURIReference' uri       abs'  <- nonStrictRelativeTo uri' base'       return $ show abs' @@ -924,7 +936,7 @@     = arrL (maybeToList . getPart)       where       getPart s = do-		  uri <- parseURIReference s+		  uri <- parseURIReference' s 		  return (sel uri)  -- ------------------------------------------------------------
src/Text/XML/HXT/DOM/Unicode.hs view
@@ -1063,6 +1063,7 @@       , (isoLatin1,	unicodeToLatin1		)       , (usAscii,	unicodeToXmlEntity	)       , (ucs2,		ucs2ToUnicode		)+      , (unicodeString,	id			)       , ("",		unicodeToUtf8		)	-- default       ] 
src/Text/XML/HXT/DOM/Util.hs view
@@ -19,6 +19,10 @@     ( stringTrim     , stringToLower     , stringToUpper+    , stringAll+    , stringFirst+    , stringLast+     , normalizeNumber     , normalizeWhitespace     , normalizeBlanks@@ -48,7 +52,9 @@     ) where -import Data.Char+import 		 Data.Char+import 		 Data.List+import		 Data.Maybe  -- ------------------------------------------------------------ @@ -70,6 +76,23 @@ stringToLower		:: String -> String stringToLower		= map toLower ++-- | find all positions where a string occurs within another string++stringAll	:: (Eq a) => [a] -> [a] -> [Int]+stringAll x	= map fst . filter ((x `isPrefixOf`) . snd) . zip [0..] . tails++-- | find the position of the first occurence of a string++stringFirst	:: (Eq a) => [a] -> [a] -> Maybe Int+stringFirst x	= listToMaybe . stringAll x++-- | find the position of the last occurence of a string++stringLast	:: (Eq a) => [a] -> [a] -> Maybe Int+stringLast x	= listToMaybe . reverse . stringAll x++-- ------------------------------------------------------------ -- | Removes leading \/ trailing whitespaces and leading zeros  normalizeNumber		:: String -> String
src/Text/XML/HXT/DOM/XmlKeywords.hs view
@@ -26,7 +26,9 @@ t_xml,				-- tag names  t_root		:: String -a_canonicalize,+a_accept_mimetypes,+ a_add_default_dtd,+ a_canonicalize,  a_default,			-- attribute names  a_check_namespaces,  a_contentLength,@@ -57,6 +59,7 @@  a_modifier,  a_name,  a_no_empty_elements,+ a_no_empty_elem_for,  a_no_redirect,  a_no_xml_pi,  a_options_curl,@@ -64,6 +67,7 @@  a_output_file,  a_output_xml,  a_output_html,+ a_output_xhtml,  a_parse_by_mimetype,  a_parse_html,  a_parse_xml,@@ -136,6 +140,8 @@ t_xml		= "xml" t_root		= "/"		-- name of root node tag +a_accept_mimetypes		= "accept-mimetypes"+a_add_default_dtd               = "add-default-dtd" a_canonicalize			= "canonicalize" a_check_namespaces		= "check-namespaces" a_collect_errors		= "collect-errors"@@ -167,12 +173,14 @@ a_modifier			= "modifier" a_name				= "name" a_no_empty_elements		= "no-empty-elements"+a_no_empty_elem_for             = "no-empty-elem-for" a_no_redirect	 		= "no-redirect" a_no_xml_pi                     = "no-xml-pi" a_options_curl			= "options-curl" a_output_file			= "output-file" a_output_encoding		= "output-encoding" a_output_html			= "output-html"+a_output_xhtml			= "output-xhtml" a_output_xml			= "output-xml" a_parse_by_mimetype		= "parse-by-mimetype" a_parse_html			= "parse-html"@@ -244,6 +252,9 @@ k_required	= "#REQUIRED" k_default	= "#DEFAULT" ++dtdPrefix	:: String+dtdPrefix	= "doctype-"  -- ------------------------------------------------------------ --
src/Text/XML/HXT/DOM/XmlOptions.hs view
@@ -56,12 +56,13 @@       , Option ""	[a_issue_errors]		(NoArg	(att a_issue_errors      v_1))	"issue all errorr messages on stderr (default)"       , Option ""	[a_do_not_issue_errors]		(NoArg	(att a_issue_errors      v_0))	"ignore all error messages"       , Option ""	[a_ignore_encoding_errors]	(NoArg  (att a_ignore_encoding_errors v_1))   "ignore encoding errors"-      , Option ""	[a_ignore_none_xml_contents]    (NoArg  (att a_ignore_none_xml_contents v_1)) "discards all contents of none XML/HTML documents, only the meta info remains stays in the doc tree"+      , Option ""	[a_ignore_none_xml_contents]    (NoArg  (att a_ignore_none_xml_contents v_1)) "discards all contents of none XML/HTML documents, only the meta info remains in the doc tree"+      , Option ""	[a_accept_mimetypes]            (ReqArg (att a_accept_mimetypes) "MIMETYPES") "only accept documents matching the given list of mimetype specs"       , Option "H"	[a_parse_html]			(NoArg	(att a_parse_html        v_1))	"parse input as HTML, try to interprete everything as HTML, no validation"       , Option "M"	[a_parse_by_mimetype]		(NoArg  (att a_parse_by_mimetype v_1))	"parse dependent on mime type: text/html as HTML, text/xml and text/xhtml and others as XML, else no parse"       , Option ""	[a_parse_xml]			(NoArg	(att a_parse_html        v_0))	"parse input as XML, (default)"       , Option ""       [a_strict_input]		(NoArg  (att a_strict_input      v_1))  "read input files strictly, this ensures closing the files correctly even if not read completely"-      , Option "T"	[a_tagsoup]			(NoArg	(att a_tagsoup           v_1))	"lasy tagsoup parser, for HTML and XML, no DTD, no validation, no PIs, only XHTML entityrefs"+      , Option "T"	[a_tagsoup]			(NoArg	(att a_tagsoup           v_1))	"lazy tagsoup parser, for HTML and XML, no DTD, no validation, no PIs, only XHTML entityrefs"       , Option ""	[a_issue_warnings]		(NoArg	(att a_issue_warnings    v_1))	"issue warnings, when parsing HTML (default)"       , Option "Q"	[a_do_not_issue_warnings]	(NoArg	(att a_issue_warnings    v_0))	"ignore warnings, when parsing HTML"       , Option ""	[a_validate]			(NoArg  (att a_validate          v_1))	"document validation when parsing XML (default)"@@ -115,7 +116,10 @@       , Option "f"	[a_output_file]		(ReqArg (att a_output_file)        "FILE")	"output file for resulting document (default: stdout)"       , Option ""	[a_output_html]	        (NoArg  (att a_output_html           v_1))	"output of none ASCII chars as HTMl entity references"       , Option ""       [a_no_xml_pi]	        (NoArg  (att a_no_xml_pi             v_1))      ("output without <?xml ...?> processing instruction, useful in combination with --" ++ show a_output_html)+      , Option ""	[a_output_xhtml]        (NoArg  (att a_output_xhtml          v_1))	"output of HTML elements with empty content (script, ...) done in format <elem...></elem> instead of <elem/>"+      , Option ""       [a_no_empty_elem_for]   (ReqArg (att a_no_empty_elem_for) "NAMES")      "output of empty elements done in format <elem...></elem> only for given list of element names"       , Option ""       [a_no_empty_elements]   (NoArg  (att a_no_empty_elements     v_1))      "output of empty elements done in format <elem...></elem> instead of <elem/>"+      , Option ""       [a_add_default_dtd]     (NoArg  (att a_add_default_dtd       v_1))      "add the document type declaration given in the input document"       ]     where     att n v	= (n, v)
src/Text/XML/HXT/IO/GetFILE.hs view
@@ -25,6 +25,9 @@ import qualified Data.ByteString        as B import qualified Data.ByteString.Char8  as C +import		 Network.URI		( unEscapeString+					)+ import           System.IO		( IOMode(..) 					, openFile 					  -- , getContents  is defined in the prelude@@ -69,26 +72,24 @@ 					        String) getCont strictInput source     = do			-- preliminary-      exists <- doesFileExist source'-      if not exists-	 then return $ fileErr "file not found"-	 else do-	      perm <- getPermissions source'-	      if not (readable perm)-	         then return $ fileErr "file not readable"-	         else do-		      c <- try ( if strictInput-				 then do-				      cb <- B.readFile source-				      return (C.unpack cb)-				 else do-				      h <- openFile source' ReadMode-				      hGetContents h-			       )-		      return (either readErr Right c)+      source'' <- checkFile source'+      case source'' of+           Nothing -> return $ fileErr "file not found"+	   Just fn -> do+		      perm <- getPermissions fn+		      if not (readable perm)+			 then return $ fileErr "file not readable"+			 else do+			      c <- try $+				   if strictInput+				      then do+					   cb <- B.readFile fn+					   return (C.unpack cb)+				      else do+					   h <- openFile fn ReadMode+					   hGetContents h+			      return (either readErr Right c)     where--    -- please NO call of unEscapeString for file names, NOT: source' = drivePath . unEscapeString $ source     source' = drivePath $ source     readErr e 	= fileErr (ioeGetErrorString e)@@ -108,5 +109,23 @@     drivePath file 	= file +-- | check whether file exists, if not+-- try to unescape filename and check again+-- return the existing filename++checkFile	:: String -> IO (Maybe String)+checkFile fn+    = do+      exists <- doesFileExist fn+      if exists+	 then return (Just fn)+	 else do+	      exists' <- doesFileExist fn'+	      return ( if exists'+		       then Just fn'+		       else Nothing+		     )+    where+    fn' = unEscapeString fn  -- ------------------------------------------------------------
src/Text/XML/HXT/IO/GetHTTPLibCurl.hs view
@@ -87,7 +87,7 @@ getCont options uri     = do       initCurl-      resp <- curlGetResponse uri curlOptions+      resp <- curlGetResponse_ uri curlOptions       -- dumpResponse       return $ evalResponse resp     where@@ -135,7 +135,7 @@ 	mkH x y	= (x, dropWhile isSpace y)  	headers-	    = map (\ (k, v) -> mkH (httpPrefix ++ k) v) rsh+	    = map (\ (k, v) -> mkH (httpPrefix ++ stringToLower k) v) rsh 	      ++               statusLine (words rsl) @@ -207,6 +207,7 @@       &&       isIntArg v			= [CurlTimeoutMS           $ read    v]     | k `elem` ["-n", "--netrc"]	= [CurlNetrcFile                     v]+    | k `elem` ["--ssl-verify-peer"]	= [CurlSSLVerifyPeer $ read v]     | k `elem` ["-R", "--remote-time"]  = [CurlFiletime            $ isTrue  v]     | k `elem` ["-u", "--user"]		= [CurlUserPwd                       v]     | k `elem` ["-U", "--proxy-user"]	= [CurlProxyUserPwd                  v]
src/Text/XML/HXT/Parser/TagSoup.hs view
@@ -9,7 +9,7 @@    Stability  : experimental    Portability: portable -   lasy HTML and simpe XML parser implemented with tagsoup+   lazy HTML and simpe XML parser implemented with tagsoup    parsing is done with a very simple monadic top down parser  -}@@ -294,7 +294,7 @@ 			   )       )     where-    -- This is essential for lasy parsing:+    -- This is essential for lazy parsing:     -- the call of "take 1" stops parsing, when the first element is detected     -- no check on end of input sequence is required to build this (0- or 1-element list)     -- so eof is never checked unneccessarily
src/Text/XML/HXT/RelaxNG/Simplification.hs view
@@ -54,8 +54,18 @@ import Text.XML.HXT.RelaxNG.SchemaGrammar as SG  import Data.Maybe-import Data.Char+    ( fromJust+    , fromMaybe+    , isNothing+    ) import Data.List+    ( elemIndices+    , isPrefixOf+    , nub+    , deleteBy+    , find+    , (\\)+    )  import System.Directory   ( doesFileExist )@@ -223,7 +233,7 @@ 		>>>                  arr (\ a -> fromMaybe "" (expandURIString a u))                 >>> -- the uri should not have a fragment-identifier (4.5)-                ( (arr (++ ", it is not a valid URI for text/xml"))+                ( arr ("illegal URI, fragment identifier not allowed: " ++)                   `whenNot`                   (getFragmentFromURI >>> isA null)                 )@@ -359,12 +369,16 @@   where   importExternalRef :: String -> String -> IOSArrow XmlTree XmlTree   importExternalRef ns href-    = ifA ( -- test whether the referenced schema exists-            neg $ constA href >>> getPathFromURI >>> isIOA doesFileExist+    = ifA ( neg $ constA href+                  >>> getPathFromURI+                  >>> ( isA (not . ("illegal URI" `isPrefixOf`))+                        `guards`+                        isIOA doesFileExist+                      )           )         ( mkRelaxError ""-	  ( "Can't read " ++ show href ++-	    ", referenced in externalRef-Pattern"+	  ( show href +++	    ": can't read URI, referenced in externalRef-Pattern" 	  ) 	)         ( ifP (const $ elem href extHRefs)@@ -377,7 +391,7 @@             )             ( ifA ( if validateExternalRef 					-- if validation parameters are set 		    then validateDocWithRelax S.relaxSchemaArrow [] href	-- the referenced schema is validated with respect to-		    else none							-- the Relax NG spezification+		    else none							-- the Relax NG specification                   )                 ( mkRelaxError "" 		  ( "The content of the schema " ++ show href ++ 
src/Text/XML/HXT/Version.hs view
@@ -1,4 +1,4 @@ module Text.XML.HXT.Version where hxt_version :: String-hxt_version = "8.3.0"+hxt_version = "8.3.2"
src/hxt-package.hs view
@@ -37,7 +37,7 @@  part3a	:: [String] part3a-    = [ "tested-with: ghc-6.10"+    = [ "tested-with: ghc-6.10.4"       , "exposed: True"       , "exposed-modules:"       ]@@ -58,7 +58,17 @@       , "import-dirs: " ++ dir ++ "/imports"       , "library-dirs: " ++ dir       , "hs-libraries: HShxt"-      , "depends: base-4.0.0.0,"+      , "build-depends: base >= 4.0.0.0,"+      , "         haskell98 >= 1.0.1.0,"+      , "         bytestring >= 0.9.1.4,"+      , "         parallel >= 1.1.0.0,"+      , "         parsec >= 2.1.0.1,"+      , "         network >= 2.2.0.1,"+      , "         containers >= 0.2.0.0,"+      , "         directory >= 1.0.0.2,"+      , "         tagsoup >= 0.6,"+      , "         curl >= 1.3.3"+{-      , "depends: base-4.0.0.0,"       , "         haskell98-1.0.1.0,"       , "         bytestring-0.9.1.4,"       , "         parallel-1.1.0.0,"@@ -68,7 +78,7 @@       , "         directory-1.0.0.2,"       , "         tagsoup-0.6,"       , "         curl-1.3.3"-      ]+-}      ]  part4b :: [String] part4b@@ -81,7 +91,7 @@       , "                containers >= 0.1 && < 1,"       , "                directory  >= 1 && < 2,"       , "                filepath   >= 1 && < 2,"-      , "                parsec     >= 2.1 && < 3,"+      , "                parsec     >= 2.1 && < 4,"       , "                HUnit      >= 1.2 && < 2,"       , "                network    >= 2.1 && < 3,"       , "                parallel   >= 1.0 && < 2,"