hxt 9.2.2 → 9.3.0.1

raw patch · 11 files changed

+231/−58 lines, 11 filesdep ~HUnitdep ~binarydep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HUnit, binary, bytestring, containers, directory, filepath, mtl, parsec

API changes (from Hackage documentation)

Files

• hxt.cabal +8/−4
• src/Text/XML/HXT/Arrow/Pickle.hs +1/−2
• src/Text/XML/HXT/Arrow/ProcessDocument.hs +1/−1
• src/Text/XML/HXT/Arrow/ReadDocument.hs +39/−11
• src/Text/XML/HXT/Arrow/XmlRegex.hs +85/−26
• src/Text/XML/HXT/Arrow/XmlState.hs +1/−1
• src/Text/XML/HXT/Arrow/XmlState/RunIOStateArrow.hs +16/−0
• src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs +42/−6
• src/Text/XML/HXT/DOM/QualifiedName.hs +3/−0
• src/Text/XML/HXT/IO/GetFILE.hs +5/−4
• src/Text/XML/HXT/XMLSchema/DataTypeLibW3CNames.hs +30/−3

@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name:           hxt-Version:        9.2.2+Version:        9.3.0.1 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.@@ -15,10 +15,14 @@                 hxt-curl, hxt-tagsoup, hxt-relaxng, hxt-xpath, hxt-xslt, 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.0: upper bound for network set to be < 2.4 (URI signatures changed in 2.4)                 .-                Changes to 9.2.1: user defined mime type handlers added+                Changes from 9.2.2: XMLSchema validation integrated                 .-                Changes to 9.2.0: New warnings from ghc-7.4 removed+                Changes from 9.2.1: user defined mime type handlers added+                .+                Changes from 9.2.0: New warnings from ghc-7.4 removed License:        MIT License-file:   LICENSE Author:         Uwe Schmidt, Martin Schmidt, Torben Kuseler@@ -176,7 +180,7 @@                 parsec     >= 2.1 && < 4,                 HUnit      >= 1.2 && < 2,                 mtl        >= 2   && < 3,-                network    >= 2.1 && < 3,+                network    >= 2.1 && < 2.4,                 deepseq    >= 1.1 && < 2,                 bytestring >= 0.9 && < 1,                 binary     >= 0.5 && < 1,

@@ -53,7 +53,7 @@     , showPickled      , PU(..)-    , XmlPickler+    , XmlPickler(..)      , xp4Tuple     , xp5Tuple@@ -95,7 +95,6 @@     , xpElemWithAttrValue     , xpFilterAttr     , xpFilterCont-    , xpickle     , xpInt     , xpLift     , xpLiftEither

@@ -105,7 +105,7 @@         ( ifA (fromLA getDTDSubset)           ( processDTDandEntities             >>>-            ( if validate'			-- validation only possible if DTD there+            ( if validate'			-- validation only possible if there is a DTD               then validateDocument               else this             )

@@ -55,7 +55,8 @@ {- | the main document input filter -this filter can be configured by a list of configuration options, a value of type 'Text.XML.HXT.XmlState.TypeDefs.SysConfig'+this filter can be configured by a list of configuration options,+a value of type 'Text.XML.HXT.XmlState.TypeDefs.SysConfig'  for all available options see module 'Text.XML.HXT.XmlState.SystemConfig' @@ -72,7 +73,8 @@ - @withSubstHTMLEntities yes\/no@ :   switch on\/off entity substitution for general entities defined in HTML validation.   Default is @no@.-  Switching this option on and the validation and substDTDEntities off can lead to faster parsing, in that case+  Switching this option on and the validation and substDTDEntities off can lead to faster parsing,+  in that case   reading the DTD documents is not longer necessary, HTML general entities are still substituted.   Only used with XML parsed documents, not with HTML parsing. @@ -222,7 +224,8 @@           getSysVar (theParseByMimeType   .&&&.                      theParseHTML         .&&&.                      theAcceptedMimeTypes .&&&.-                     theRelaxValidate+                     theRelaxValidate     .&&&.+                     theXmlSchemaValidate                     )         )       )@@ -276,7 +279,12 @@             processDoc' mimeType options           ) -    processDoc' mimeType (parseByMimeType, (parseHtml, (acceptedMimeTypes, validateWithRelax)))+    processDoc' mimeType ( parseByMimeType+                         , ( parseHtml+                           , ( acceptedMimeTypes+                             , ( validateWithRelax+                               , validateWithXmlSchema+                               ))))         = ( if isAcceptedMimeType acceptedMimeTypes mimeType             then ( processNoneEmptyDoc                    ( ( parse $< getSysVar (theValidate              .&&&.@@ -307,7 +315,7 @@                                                         )                               )                               >>>-                              relax+                              relaxOrXmlSchema                             )                        else this                      )@@ -339,7 +347,13 @@                                             (mi == mis || mis == "*")                                           )                                           || r-        parse (validate, (substDTD, (substHTML, (removeNoneXml, (withTagSoup', withExpat')))))+        parse ( validate+              , ( substDTD+                , ( substHTML+                  , ( removeNoneXml+                    , ( withTagSoup'+                      , withExpat'+                      )))))             | not isXmlOrHtml           = if removeNoneXml                                           then replaceChildren none             -- don't parse, if mime type is not XML nor HTML                                           else this                             -- but remove contents when option is set@@ -352,7 +366,11 @@              | isXml                     = if withExpat'                                           then parseXmlDocumentWithExpat-                                          else parseXmlDocument validate substDTD substHTML validateWithRelax+                                          else parseXmlDocument+                                               validate+                                               substDTD+                                               substHTML+                                               validateWithRelax                                                                                 -- parse as XML             | otherwise                 = this                                  -- suppress warning @@ -363,25 +381,35 @@              | withNamespaces               ||-              validateWithRelax         = propagateAndValidateNamespaces        -- RelaxNG requires correct namespaces+              validateWithRelax+              ||+              validateWithXmlSchema+                                        = propagateAndValidateNamespaces        -- RelaxNG and XML Schema require correct namespaces              | otherwise                 = this          canonicalize (preserveCmt, (canonicalize', withTagSoup'))             | withTagSoup'              = this                                  -- tagsoup already removes redundant stuff-            | validateWithRelax         = canonicalizeAllNodes+            | validateWithRelax+              ||+              validateWithXmlSchema     = canonicalizeAllNodes                  -- no comments in schema validation+             | canonicalize'               &&               preserveCmt               = canonicalizeForXPath             | canonicalize'             = canonicalizeAllNodes             | otherwise                 = this -        relax+        relaxOrXmlSchema+            | validateWithXmlSchema     = withoutUserState $< getSysVar theXmlSchemaValidator             | validateWithRelax         = withoutUserState $< getSysVar theRelaxValidator             | otherwise                 = this          whitespace (removeWS, withTagSoup')-            | removeWS+            | ( removeWS+                ||+                validateWithXmlSchema                                           -- XML Schema does not like WS+              )               &&               not withTagSoup'          = removeDocWhiteSpace                   -- tagsoup already removes whitespace             | otherwise                 = this

@@ -11,7 +11,7 @@     Regular Expression Matcher working on lists of XmlTrees -   It's intendet to import this module with an explicit+   It's intended to import this module with an explicit    import declaration for not spoiling the namespace    with these somewhat special arrows @@ -24,6 +24,7 @@     , mkZero     , mkUnit     , mkPrim+    , mkPrim'     , mkPrimA     , mkDot     , mkStar@@ -34,6 +35,9 @@     , mkRep     , mkRng     , mkOpt+    , mkPerm+    , mkPerms+    , mkMerge     , nullable     , delta     , matchXmlRegex@@ -50,6 +54,7 @@ import Data.Maybe  import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.ShowXml  ( xshow )  -- ------------------------------------------------------------ -- the exported regex arrows@@ -88,13 +93,15 @@  data XmlRegex   = Zero String                 | Unit-                | Sym (XmlTree -> Bool)+                | Sym  (XmlTree -> Bool) String    -- optional external repr. of predicate                 | Dot-                | Star XmlRegex-                | Alt XmlRegex XmlRegex-                | Seq XmlRegex XmlRegex-                | Rep Int XmlRegex              -- 1 or more repetitions-                | Rng Int Int XmlRegex  -- n..m repetitions+                | Star  XmlRegex+                | Alt   XmlRegex XmlRegex+                | Seq   XmlRegex XmlRegex+                | Rep   Int      XmlRegex          -- 1 or more repetitions+                | Rng   Int Int  XmlRegex          -- n..m repetitions+                | Perm  XmlRegex XmlRegex+                | Merge XmlRegex XmlRegex  -- ------------------------------------------------------------ @@ -106,7 +113,7 @@ instance Inv XmlRegex where     inv (Zero _)        = True     inv Unit            = True-    inv (Sym p)         = p holds for some XmlTrees+    inv (Sym p _)       = p holds for some XmlTrees     inv Dot             = True     inv (Star e)        = inv e     inv (Alt e1 e2)     = inv e1 &&@@ -116,6 +123,8 @@     inv (Rep i e)       = i > 0 && inv e     inv (Rng i j e)     = (i < j || (i == j && i > 1)) &&                           inv e+    inv (Perm e1 e2)    = inv e1 &&+                          inv e2 -} -- ------------------------------------------------------------ --@@ -128,8 +137,11 @@ mkUnit          = Unit  mkPrim          :: (XmlTree -> Bool) -> XmlRegex-mkPrim          = Sym+mkPrim p        = Sym p "" +mkPrim'         :: (XmlTree -> Bool) -> String -> XmlRegex+mkPrim'         = Sym+ mkPrimA         :: LA XmlTree XmlTree -> XmlRegex mkPrimA a       = mkPrim (not . null . runLA a) @@ -155,9 +167,14 @@ mkAlt (Zero _)      e2                  = e2                            -- {} u e2 = e2 mkAlt e1@(Star Dot) _e2                 = e1                            -- A* u e1 = A* mkAlt _e1           e2@(Star Dot)       = e2                            -- e1 u A* = A*-mkAlt (Sym p1)      (Sym p2)            = mkPrim $ \ x -> p1 x || p2 x  -- melting of predicates-mkAlt e1            e2@(Sym _)          = mkAlt e2 e1                   -- symmetry: predicates always first-mkAlt e1@(Sym _)    (Alt e2@(Sym _) e3) = mkAlt (mkAlt e1 e2) e3        -- prepare melting of predicates+mkAlt (Sym p1 e1)   (Sym p2 e2)         = mkPrim' (\ x -> p1 x || p2 x)  (e e1 e2) -- melting of predicates+                                          where+                                            e "" x2 = x2+                                            e x1 "" = x1+                                            e x1 x2 = x1 ++ "|" ++ x2+mkAlt e1            e2@(Sym _ _)        = mkAlt e2 e1                   -- symmetry: predicates always first+mkAlt e1@(Sym _ _)  (Alt e2@(Sym _ _) e3)+                                        = mkAlt (mkAlt e1 e2) e3        -- prepare melting of predicates mkAlt (Alt e1 e2)   e3                  = mkAlt e1 (mkAlt e2 e3)        -- associativity mkAlt e1 e2                             = Alt e1 e2 @@ -195,12 +212,30 @@ mkOpt   :: XmlRegex -> XmlRegex mkOpt   = mkRng 0 1 +mkPerm                           :: XmlRegex -> XmlRegex -> XmlRegex+mkPerm e1@(Zero _) _             = e1+mkPerm _           e2@(Zero _)   = e2+mkPerm Unit        e2            = e2+mkPerm e1          Unit          = e1+mkPerm e1          e2            = Perm e1 e2++mkPerms                          :: [XmlRegex] -> XmlRegex+mkPerms                          = foldr mkPerm mkUnit++mkMerge                          :: XmlRegex -> XmlRegex -> XmlRegex+mkMerge e1@(Zero _) _            = e1+mkMerge _           e2@(Zero _)  = e2+mkMerge Unit        e2           = e2+mkMerge e1          Unit         = e1+mkMerge e1          e2           = Merge e1 e2+ -- ------------------------------------------------------------  instance Show XmlRegex where     show (Zero s)       = "{err:" ++ s ++ "}"     show Unit           = "()"-    show (Sym _p)       = "{single tree pred}"+    show (Sym _p "")    = "<pred>"+    show (Sym _p r )    = r     show Dot            = "."     show (Star e)       = "(" ++ show e ++ ")*"     show (Alt e1 e2)    = "(" ++ show e1 ++ "|" ++ show e2 ++ ")"@@ -209,13 +244,28 @@     show (Rep i e)      = "(" ++ show e ++ "){" ++ show i ++ ",}"     show (Rng 0 1 e)    = "(" ++ show e ++ ")?"     show (Rng i j e)    = "(" ++ show e ++ "){" ++ show i ++ "," ++ show j ++ "}"+    show (Perm e1 e2)   = "(" ++ show e1 ++ show e2 ++ "|" ++ show e2 ++ show e1 ++ ")"+    show (Merge e1 e2)  = "(" ++ show e1 ++ "&" ++ show e2 ++ ")"  -- ------------------------------------------------------------ +unexpected 		:: XmlTree -> String -> String+unexpected t e		= emsg e ++ (cut 80 . xshow) [t]+    where+      emsg ""           = "unexpected: "+      emsg s            = "expected: " ++ s ++ ", but got: "+      cut n s+          | null rest   = s'+          | otherwise   = s' ++ "..."+          where+            (s', rest)  = splitAt n s++-- ------------------------------------------------------------+ nullable        :: XmlRegex -> Bool nullable (Zero _)       = False nullable Unit           = True-nullable (Sym _p)       = False         -- assumption: p holds for at least one tree+nullable (Sym _p _)     = False         -- assumption: p holds for at least one tree nullable Dot            = False nullable (Star _)       = True nullable (Alt e1 e2)    = nullable e1 ||@@ -225,25 +275,34 @@ nullable (Rep _i e)     = nullable e nullable (Rng i _ e)    = i == 0 ||                           nullable e+nullable (Perm e1 e2)   = nullable e1 &&+                          nullable e2+nullable (Merge e1 e2)  = nullable e1 &&+                          nullable e2  -- ------------------------------------------------------------  delta   :: XmlRegex -> XmlTree -> XmlRegex-delta e@(Zero _)  _     = e-delta Unit        c     = mkZero $-                          "unexpected char " ++ show c-delta (Sym p)     c+delta e@(Zero _)   _    = e+delta Unit         c    = mkZero $ unexpected c ""+delta (Sym p e)    c     | p c               = mkUnit-    | otherwise         = mkZero $-                          "unexpected tree " ++ show c-delta Dot         _     = mkUnit-delta e@(Star e1) c     = mkSeq (delta e1 c) e-delta (Alt e1 e2) c     = mkAlt (delta e1 c) (delta e2 c)-delta (Seq e1 e2) c+    | otherwise         = mkZero $ unexpected c e+delta Dot          _    = mkUnit+delta e@(Star e1)  c    = mkSeq (delta e1 c) e+delta (Alt e1 e2)  c    = mkAlt (delta e1 c) (delta e2 c)+delta (Seq e1 e2)  c     | nullable e1       = mkAlt (mkSeq (delta e1 c) e2) (delta e2 c)     | otherwise         = mkSeq (delta e1 c) e2-delta (Rep i e)   c     = mkSeq (delta e c) (mkRep (i-1) e)-delta (Rng i j e) c     = mkSeq (delta e c) (mkRng ((i-1) `max` 0) (j-1) e)+delta (Rep i e)    c    = mkSeq (delta e c) (mkRep (i-1) e)+delta (Rng i j e)  c    = mkSeq (delta e c) (mkRng ((i-1) `max` 0) (j-1) e)+delta (Perm e1 e2) c    = case e1' of+                            (Zero _) -> mkPerm e1 (delta e2 c)+                            _        -> mkPerm e1' e2+                          where+                          e1' = delta e1 c+delta (Merge e1 e2) c   = mkAlt (mkMerge (delta e1 c) e2)+                                (mkMerge e1 (delta e2 c))  -- ------------------------------------------------------------ 

@@ -104,7 +104,7 @@     , setMimeTypeTable     , setMimeTypeTableFromFile -    , -- System Configuration and options+    , -- * System Configuration and Options       yes     , no 

@@ -95,6 +95,7 @@                                   , xioParseConfig       = initialParseConfig                                   , xioOutputConfig      = initialOutputConfig                                   , xioRelaxConfig       = initialRelaxConfig+                                  , xioXmlSchemaConfig   = initialXmlSchemaConfig                                   , xioCacheConfig       = initialCacheConfig                                   } @@ -158,6 +159,13 @@                                   , xioRelaxValidator           = dummyRelaxValidator                                   } +initialXmlSchemaConfig          :: XIOXmlSchemaConfig+initialXmlSchemaConfig          = XIOScc+                                  { xioXmlSchemaValidate        = False+                                  , xioXmlSchemaSchema          = ""+                                  , xioXmlSchemaValidator       = dummyXmlSchemaValidator+                                  }+ initialCacheConfig              :: XIOCacheConfig initialCacheConfig              = XIOCch                                    { xioBinaryCompression       = id@@ -208,6 +216,14 @@                            [ "RelaxNG validator not configured,"                            , "please install package hxt-relaxng"                            , " and use 'withRelaxNG' config option from this package"+                           ]++dummyXmlSchemaValidator :: IOSArrow b b+dummyXmlSchemaValidator =  issueFatal $+                           unlines $+                           [ "XML Schema validator not configured,"+                           , "please install package hxt-xmlschema"+                           , " and use 'withXmlSchema' config option from this package"                            ]  dummyCacheRead          :: String -> IOSArrow b b

@@ -180,6 +180,7 @@                                   , xioParseConfig              :: ! XIOParseConfig                                   , xioOutputConfig             :: ! XIOOutputConfig                                   , xioRelaxConfig              :: ! XIORelaxConfig+                                  , xioXmlSchemaConfig          :: ! XIOXmlSchemaConfig                                   , xioCacheConfig              :: ! XIOCacheConfig                                   } @@ -237,6 +238,11 @@                                   , xioRelaxValidator           ::   IOSArrow XmlTree XmlTree                                   } +data XIOXmlSchemaConfig = XIOScc  { xioXmlSchemaValidate        :: ! Bool+                                  , xioXmlSchemaSchema          ::   String+                                  , xioXmlSchemaValidator       ::   IOSArrow XmlTree XmlTree+                                  }+ data XIOCacheConfig     = XIOCch  { xioBinaryCompression        ::   CompressionFct                                   , xioBinaryDeCompression      ::   DeCompressionFct                                   , xioWithCache                :: ! Bool@@ -495,12 +501,42 @@                                     , setS = \ x s -> s { xioRelaxCollectErrors = x}                                     } -theRelaxValidator                :: Selector XIOSysState (IOSArrow XmlTree XmlTree)-theRelaxValidator                = theRelaxConfig-                                   >>>-                                   S { getS = xioRelaxValidator-                                     , setS = \ x s -> s { xioRelaxValidator = x}-                                     }+theRelaxValidator               :: Selector XIOSysState (IOSArrow XmlTree XmlTree)+theRelaxValidator               = theRelaxConfig+                                  >>>+                                  S { getS = xioRelaxValidator+                                    , setS = \ x s -> s { xioRelaxValidator = x}+                                    }++-- ----------------------------------------++theXmlSchemaConfig              :: Selector XIOSysState XIOXmlSchemaConfig+theXmlSchemaConfig              = theSysEnv+                                  >>>+                                  S { getS = xioXmlSchemaConfig+                                    , setS = \ x s -> s { xioXmlSchemaConfig = x}+                                    }++theXmlSchemaValidate            :: Selector XIOSysState Bool+theXmlSchemaValidate            = theXmlSchemaConfig+                                  >>>+                                  S { getS = xioXmlSchemaValidate+                                    , setS = \ x s -> s { xioXmlSchemaValidate = x}+                                    }++theXmlSchemaSchema              :: Selector XIOSysState String+theXmlSchemaSchema              = theXmlSchemaConfig+                                  >>>+                                  S { getS = xioXmlSchemaSchema+                                    , setS = \ x s -> s { xioXmlSchemaSchema = x}+                                    }++theXmlSchemaValidator           :: Selector XIOSysState (IOSArrow XmlTree XmlTree)+theXmlSchemaValidator           = theXmlSchemaConfig+                                  >>>+                                  S { getS = xioXmlSchemaValidator+                                    , setS = \ x s -> s { xioXmlSchemaValidator = x}+                                    }  -- ---------------------------------------- 

@@ -181,6 +181,9 @@                                   &&                    -- and prefixes are not set or they are equal                                   px1 == px2 +instance Ord QName where+  compare x y = compare (qualifiedName x) (qualifiedName y)+ instance NFData  QName instance WNFData QName 

@@ -31,8 +31,8 @@ import           System.IO.Error        ( ioeGetErrorString                                         ) import           System.Directory       ( doesFileExist-                                        , getPermissions-                                        , readable+                                        -- , getPermissions+                                        -- , readable                                         ) import           Text.XML.HXT.DOM.XmlKeywords @@ -66,8 +66,9 @@       case source'' of            Nothing -> return $ fileErr "file not found"            Just fn -> do-                      perm <- getPermissions fn-                      if not (readable perm)+                      -- perm <- getPermissions fn  -- getPermission may fail+                      -- if not (readable perm)+                      if False                          then return $ fileErr "file not readable"                          else do                               c <- try $

@@ -26,7 +26,6 @@ w3cNS   :: String w3cNS   = "http://www.w3.org/2001/XMLSchema-datatypes" - xsd_string  , xsd_normalizedString  , xsd_token@@ -58,8 +57,21 @@  , xsd_unsignedLong  , xsd_unsignedInt  , xsd_unsignedShort- , xsd_unsignedByte :: String+ , xsd_unsignedByte + , xsd_boolean+ , xsd_float+ , xsd_double+ , xsd_time+ , xsd_duration+ , xsd_date+ , xsd_dateTime+ , xsd_gDay+ , xsd_gMonth+ , xsd_gMonthDay+ , xsd_gYear+ , xsd_gYearMonth :: String+ xsd_string              = "string" xsd_normalizedString    = "normalizedString" xsd_token               = "token"@@ -93,6 +105,18 @@ xsd_unsignedShort       = "unsignedShort" xsd_unsignedByte        = "unsignedByte" +xsd_boolean             = "boolean"+xsd_float               = "float"+xsd_double              = "double"+xsd_time                = "time"+xsd_duration            = "duration"+xsd_date                = "date"+xsd_dateTime            = "dateTime"+xsd_gDay                = "gDay"+xsd_gMonth              = "gMonth"+xsd_gMonthDay           = "gMonthDay"+xsd_gYear               = "gYear"+xsd_gYearMonth          = "gYearMonth"  xsd_length  , xsd_maxLength@@ -104,7 +128,8 @@  , xsd_totalDigits  , xsd_fractionDigits  , xsd_pattern- , xsd_enumeration :: String+ , xsd_enumeration+ , xsd_whiteSpace :: String  xsd_length              = "length" xsd_maxLength           = "maxLength"@@ -120,5 +145,7 @@  xsd_pattern             = "pattern" xsd_enumeration         = "enumeration"++xsd_whiteSpace          = "whiteSpace"  -- ----------------------------------------