HaXml 1.25.13 → 1.25.14

raw patch · 11 files changed

+67/−23 lines, 11 filesdep ~basedep ~containersdep ~randomsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, containers, random

API changes (from Hackage documentation)

Files

• Changelog.md +13/−0
• HaXml.cabal +7/−7
• Setup.hs +0/−2
• src/Text/XML/HaXml/Namespaces.hs +2/−0
• src/Text/XML/HaXml/Parse.hs +14/−1
• src/Text/XML/HaXml/ParseLazy.hs +14/−1
• src/Text/XML/HaXml/Schema/Environment.hs +1/−0
• src/Text/XML/HaXml/Schema/NameConversion.hs +1/−1
• src/Text/XML/HaXml/Schema/Parse.hs +1/−5
• src/Text/XML/HaXml/Schema/PrettyHaskell.hs +7/−5
• src/Text/XML/HaXml/Schema/TypeConversion.hs +7/−1

@@ -1,3 +1,16 @@+## 1.25.14 (2024-12-12)+- fix inaccuracies in haskell generation code (#17 from @SiriusCourses):+  - Fix mkNamespace for case when QName is recognized at root element+  - Fix QName parser to recognize names with namespaces+  - Prevent multiple declarations after type lifting hoist+  - Inject groups from reference at topElementDecl+  - Fix bug unexcaped module name in generated haskell code+  - Add to Environment deriving for Show and Eq for simpler debug+  - Fix name with dashes for simpleType+- PrettyH*: Add missing pattern match to ppComment (#24 from @e-rk)+- Allow base-4.20 and filepath-1.5; bump CI to GHC 9.8 (#21, @andreasabel)+- allow base-4.22 for ghc-9.12 (#23, @juhp)+ ## 1.25.13 (2023-07-13) - correct zero time duration P0S to PT0S (@dten, #16) - allow ghc-9.6 base (@andreasabel, #15)

@@ -1,7 +1,6 @@ cabal-version:  1.18 name:           HaXml-version:        1.25.13-x-revison:      1+version:        1.25.14  license:        LGPL-2.1 license-files:  COPYRIGHT, LICENCE-GPL, LICENCE-LGPL@@ -18,8 +17,9 @@ extra-doc-files: Changelog.md README  tested-with:-  GHC ==9.6.2-   || ==9.4.5+  GHC ==9.8.2+   || ==9.6.6+   || ==9.4.8    || ==9.2.8    || ==9.0.2    || ==8.10.7@@ -83,10 +83,10 @@         Text.XML.HaXml.Schema.Schema   hs-source-dirs: src   build-depends:-    base       >= 4.3.1.0  && < 4.19,+    base       >= 4.3.1.0  && < 4.22,     bytestring >= 0.9.1.10 && < 0.13,-    containers >= 0.4.0.0  && <0.7,-    filepath   >= 1.2.0.0  && <1.5,+    containers >= 0.4.0.0  && <0.8,+    filepath   >= 1.2.0.0  && <1.6,     pretty     >= 1.0.1.2  && <1.2,     random     >= 1.0      && <1.3,     polyparse  >= 1.12.1   && <1.14

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -171,6 +171,8 @@               mkNamespace :: Attribute -> Namespace               mkNamespace (N n, atv)  = let (_,':':nm) = span (/=':') n in                                         Namespace{nsPrefix=nm,nsURI=show atv}+              mkNamespace (q@(QN (Namespace{ nsURI="" }) n), atv)  =+                                        Namespace{nsPrefix=n,nsURI=show atv}               matching :: (String->Bool) -> [Attribute] -> [Attribute]               matching p = filter (p . printableName . fst)     --

@@ -172,7 +172,20 @@ -- | Return a qualified name (although the namespace qualification is not --   processed here; this is merely to get the correct type). qname :: XParser QName-qname = fmap N name+qname = do+    (p,tok) <- next+    case tok of+        TokName s  -> case split ':' s of+            [one] -> return $ N s+            [ns,elem_name] -> return $ QN (Namespace ns "") elem_name+            _ -> report fail "a name" p tok+        TokError _ -> report failBad "a name" p tok+        _          -> report fail "a name" p tok+    where+    split :: Char -> String -> [String]+    split c xs = case break (==c) xs of+        (ls, "") -> [ls]+        (ls, x:rs) -> ls : split c rs  -- | Return just a name, e.g. element name, attribute name. name :: XParser Name

@@ -176,7 +176,20 @@ -- | Return a qualified name (although the namespace qualification is not --   processed here; this is merely to get the correct type). qname :: XParser QName-qname = fmap N name+qname = do+    (p,tok) <- next+    case tok of+        TokName s  -> case split ':' s of+            [one] -> return $ N s+            [ns,elem_name] -> return $ QN (Namespace ns "") elem_name+            _ -> report fail "a name" p tok+        TokError _ -> report failBad "a name" p tok+        _          -> report fail "a name" p tok+    where+    split :: Char -> String -> [String]+    split c xs = case break (==c) xs of+        (ls, "") -> [ls]+        (ls, x:rs) -> ls : split c rs  -- | Return just a name, e.g. element name, attribute name. name :: XParser Name

@@ -56,6 +56,7 @@     , env_substGrp  :: Map QName [(QName,FilePath)] -- ^ substitution groups     , env_typeloc   :: Map QName FilePath           -- ^ where type is defined     }+    deriving (Show, Eq)  -- | An empty environment of XSD type mappings. emptyEnv :: Environment

@@ -68,7 +68,7 @@                         | map toLower c == "integer"    = "Xsd.Integer"                         | map toLower c == "boolean"    = "Xsd.Boolean"                         | map toLower c == "decimal"    = "Xsd.Decimal"-                        | otherwise = first toUpper m++"."++first toUpper (map escape c)+                        | otherwise = first toUpper (map escape m)++"."++first toUpper (map escape c)     mkConid more        = mkConid [concat more]     mkVarid  [v]        = first toLower (map escape v)     mkVarid [m,v]       = first toUpper m++"."++first toLower (map escape v)

@@ -292,7 +292,7 @@ simpleType :: (String->String->QName) -> XsdParser SimpleType simpleType q = do     e <- xsdElement "simpleType"-    n <- optional (attribute (N "name") name e)+    n <- optional (attribute (N "name") string e)     f <- optional (attribute (N "final") final e)     a <- interiorWith (xsdTag "annotation") annotation e     commit $ interiorWith (not . xsdTag "annotation") (simpleItem n f a) e@@ -652,7 +652,3 @@                `onFail`                  do cs <- many next                     return (N (a++cs))---- | Parse an attribute value that should be a simple Name.-name :: TextParser Name-name = word

@@ -39,12 +39,14 @@ --   (but without escapes in comment text yet) ppComment :: CommentPosition -> Comment -> Doc ppComment _   Nothing  = empty-ppComment pos (Just s) =-    text "--" <+> text (case pos of Before -> "|"; After -> "^") <+> text c-    $$-    vcat (map (\x-> text "--  " <+> text x) cs)+ppComment pos (Just s) = case ps of+  (c:cs) ->+      text "--" <+> text (case pos of Before -> "|"; After -> "^") <+> text c+      $$+      vcat (map (\x-> text "--  " <+> text x) cs)+  [] -> empty   where-    (c:cs) = lines (paragraph 60 s)+    ps = lines (paragraph 60 s)  -- | Generate aligned haddock-style docs for choices (where each choice --   has its own documentation, but haddock cannot place it directly next

@@ -27,7 +27,9 @@                     ++ map renameLocals (schema_items s) }   where     hoist :: ElementDecl -> [SchemaItem]-    hoist e = flip concatMap (findE e) $+    hoist e =+              let only_children = filter (not . (==) e) $ findE e+              in flip concatMap only_children $               \e@ElementDecl{elem_nameOrRef=Left (NT{ theName=n                                                   {-, theType=Nothing-}})}->                   localType n (elem_content e)@@ -398,6 +400,10 @@                                                              (elem_modifier e)})                                               es)                                          (comment (group_annotation g))+        Right (QN _ ref) -> case Map.lookup (N ref) (env_group env) of+                       Nothing -> error $ "bad group reference "+                                       ++printableName (N ref)+                       Just g' -> group g'{ group_occurs=group_occurs g }         Right ref -> case Map.lookup ref (env_group env) of                   --   Nothing -> error $ "bad group reference "                   --                      ++printableName ref