HaXml 1.25.3 → 1.25.4

raw patch · 7 files changed

+74/−41 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• HaXml.cabal +8/−16
• src/Text/XML/HaXml.hs +1/−4
• src/Text/XML/HaXml/Lex.hs +3/−1
• src/Text/XML/HaXml/Schema/TypeConversion.hs +52/−17
• src/Text/XML/HaXml/Version.hs +6/−0
• src/Text/XML/HaXml/Wrappers.hs +3/−2
• src/tools/XsdToHaskell.hs +1/−1

@@ -1,5 +1,5 @@ name:		HaXml-version:	1.25.3+version:	1.25.4 license:	LGPL license-file:	COPYRIGHT author:		Malcolm Wallace <Malcolm.Wallace@me.com>@@ -55,6 +55,7 @@         Text.XML.HaXml.Util,         Text.XML.HaXml.Validate,         Text.XML.HaXml.Verbatim,+        Text.XML.HaXml.Version         Text.XML.HaXml.Wrappers,         Text.XML.HaXml.XmlContent,         Text.XML.HaXml.XmlContent.Parser,@@ -76,14 +77,12 @@   else     build-depends: base < 2 || >= 3, bytestring   extensions: CPP, ExistentialQuantification-  cpp-options: -DVERSION="\"1.25.3\""   nhc98-options: -K10M  Executable Canonicalise   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: Canonicalise.hs   build-depends: base, HaXml, pretty @@ -91,54 +90,47 @@   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: CanonicaliseLazy.hs   build-depends: base, HaXml, pretty-  + Executable Xtract   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: Xtract.hs   build-depends: base, HaXml, pretty-  + Executable Validate   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: Validate.hs   build-depends: base, HaXml-  + Executable MkOneOf   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: MkOneOf.hs   build-depends: base, HaXml-  + Executable DtdToHaskell   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: DtdToHaskell.hs   build-depends: base, HaXml, pretty-  + Executable XsdToHaskell   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: XsdToHaskell.hs   build-depends: base, HaXml, pretty, polyparse, directory-  + Executable FpMLToHaskell   GHC-Options: -Wall   Extensions:  CPP   Hs-Source-Dirs: src/tools-  cpp-options: -DVERSION="\"1.25.3\""   Main-Is: FpMLToHaskell.hs   build-depends: base, HaXml, pretty, polyparse, directory

@@ -28,10 +28,7 @@ import Text.XML.HaXml.Wrappers    (fix2Args,processXmlWith) import Text.XML.HaXml.Verbatim import Text.XML.HaXml.Escape+import Text.XML.HaXml.Version  import Text.PrettyPrint.HughesPJ  (render) --- | The version of the library.-version :: String-version  = VERSION-		-- expect cpp to fill in value

@@ -244,9 +244,11 @@     | "!"   `prefixes` ss = emit TokSpecialOpen p:                                      skip 2 p s (xmlSpecial (InTag "<!...>":w))     | "/"   `prefixes` ss = emit TokEndOpen p: -                                    skip 2 p s (xmlTag (InTag "</...>":tail w))+                                    skip 2 p s (xmlTag (InTag "</...>":tale w))     | otherwise           = emit TokAnyOpen p:                                  skip 1 p s (xmlTag (InTag "<...>":NotInTag:w))+    where tale [] = [NotInTag] -- cope with non-well-formed input+          tale xs = tail xs xmlAny (_:_:w) p s@('/':ss)     | ">"   `prefixes` ss = emit TokEndClose p: skip 2 p s (xmlAny w) xmlAny w p ('&':ss) = emit TokAmp p:      textUntil ";" TokSemi "" p

@@ -112,7 +112,7 @@     simple (Primitive prim)     = []     simple s@(Restricted a n f r)         | (Just enums) <- isEnumeration s-                                = [EnumSimpleType +                                = [EnumSimpleType                                        (maybe (error "missing Name") xname n)                                        enums (comment a) ]         | otherwise             = [RestrictSimpleType@@ -126,7 +126,7 @@                               --                      (comment a)]     simple s@(UnionOf a n f u m)         | (Just enums) <- isEnumeration s-                                = [EnumSimpleType +                                = [EnumSimpleType                                        (maybe (error "missing Name") xname n)                                        enums (comment a) ]         | otherwise             = [UnionSimpleTypes@@ -262,7 +262,7 @@                            --  Element{ elem_name = xname (theName n)                            --         , elem_type = checkXName s (N $ theName n)                            --         , elem_modifier =-                           --                     Haskell.Range (elem_occurs ed)+                           --                 occursToModifier (elem_occurs ed)                            --         , elem_byRef   = False                            --         , elem_locals  = []                            --         , elem_substs  = Nothing@@ -288,16 +288,17 @@                          singleton $ ElementOfType $ elementDecl ed                      --  Element{ elem_name    = xname $ theName n                      --         , elem_type    = checkXName s t-                     --         , elem_modifier= Haskell.Range (elem_occurs ed)+                     --         , elem_modifier=+                     --                       occursToModifier (elem_occurs ed)                      --         , elem_byRef   = False                      --         , elem_locals  = []                      --         , elem_substs  = Nothing                      --         , elem_comment = comment (elem_annotation ed)                      --         }         Right ref -> case Map.lookup ref (env_element env) of-		       Nothing -> error $ "<topElementDecl> unknown element reference "-					  ++printableName ref-		       Just e' -> topElementDecl e'+           Nothing -> error $ "<topElementDecl> unknown element reference "+                            ++printableName ref+           Just e' -> topElementDecl e'      elementDecl :: XSD.ElementDecl -> Haskell.Element     elementDecl ed = case elem_nameOrRef ed of@@ -305,7 +306,7 @@                              , elem_type     = maybe (localTypeExp ed)                                                      (checkXName s)                                                      (theType n)-                             , elem_modifier = Haskell.Range $ elem_occurs ed+                             , elem_modifier = occursToModifier $ elem_occurs ed                              , elem_byRef    = False   -- by reference                              , elem_locals   = []      -- internal Decl                              , elem_substs   = Nothing -- substitution group@@ -319,19 +320,19 @@         Right ref -> case Map.lookup ref (env_element env) of                        Just e' -> (elementDecl e')                                       { elem_modifier =-                                            Haskell.Range (elem_occurs ed)+                                              occursToModifier (elem_occurs ed)                                       , elem_byRef = True }                        Nothing -> -- possible ref is imported qualified?                            case Map.lookup (N $ localName ref)                                            (env_element env) of                                Just e' -> (elementDecl e')                                             { elem_modifier =-                                               Haskell.Range (elem_occurs ed)+                                               occursToModifier (elem_occurs ed)                                             , elem_byRef = True }                                Nothing -> Element ({-name-}XName ref)                                               -- best guess at type                                               ({-type-}XName ref)-                                              (Haskell.Range (elem_occurs ed))+                                              (occursToModifier (elem_occurs ed))                                               True [] Nothing Nothing      localTypeExp :: XSD.ElementDecl -> XName@@ -386,7 +387,12 @@         Left  n   -> let ({-highs,-}es) = choiceOrSeq (fromMaybe (error "XSD.group")                                                              (group_stuff g))                      in {-highs ++-} singleton $-                           Haskell.Group (xname n) es+                           Haskell.Group (xname n)+                                         (map (\e->e{elem_modifier=+                                                         combineOccursModifier+                                                             (group_occurs g)+                                                             (elem_modifier e)})+                                              es)                                          (comment (group_annotation g))         Right ref -> case Map.lookup ref (env_group env) of                   --   Nothing -> error $ "bad group reference "@@ -394,7 +400,7 @@                        Nothing -> singleton $                                   Haskell.Group (xname ("unknown-group-"++printableName ref)) []                                                 (comment (group_annotation g))-                       Just g' -> group g'+                       Just g' -> group g'{ group_occurs=group_occurs g }      particleAttrs :: ParticleAttrs -> ([Haskell.Element],[Haskell.Attribute])     particleAttrs (PA part attrs _) = -- ignoring AnyAttr for now@@ -410,7 +416,7 @@     choiceOrSeq (XSD.All      ann eds)   = error "not yet implemented: XSD.All"     choiceOrSeq (XSD.Choice   ann o ees) = [ OneOf (anyToEnd                                                      (map elementEtc ees))-                                                   (Haskell.Range o)+                                                   (occursToModifier o)                                                    (comment ann) ]     choiceOrSeq (XSD.Sequence ann _ ees) = concatMap elementEtc ees @@ -422,7 +428,7 @@      any :: XSD.Any -> [Haskell.Element]     any a@XSD.Any{}  = [Haskell.AnyElem-                           { elem_modifier = Haskell.Range (any_occurs a)+                           { elem_modifier = occursToModifier (any_occurs a)                            , elem_comment  = comment (any_annotation a) }]      -- If an ANY element is part of a choice, ensure it is the last part.@@ -479,8 +485,10 @@ nameOfSimple s                           = xname "String" -- anonymous simple  mkRestrict :: XSD.Restriction -> [Haskell.Restrict]-mkRestrict (RestrictSim1 ann base r1) =-        error "Not yet implemented: Restriction1 on simpletype"+mkRestrict (RestrictSim1 ann base r1) = []+--      = error "Not yet implemented: Restriction1 on simpletype"+--      ^ This branch is not strictly correct.  There ought to be some+--        restrictions. mkRestrict (RestrictType _ _ _ facets) =     (let occurs = [ (f,ann,v)  | (Facet f ann v _) <- facets                                , f `elem` [OrderedBoundsMinIncl@@ -529,6 +537,33 @@              Occurs (Just (read n)) max consolidate (Occurs min max) (UnorderedMaxLength,_,n) =              Occurs min (Just (read n))++instance Monoid Occurs where+    mempty = Occurs Nothing Nothing+    (Occurs Nothing  Nothing)  `mappend` o  = o+    (Occurs (Just z) Nothing)  `mappend` (Occurs min max)+                                        = Occurs (Just $ maybe z (*z) min) max+    (Occurs Nothing  (Just x)) `mappend` (Occurs min max)+                                        = Occurs min (Just $ maybe x (*x) max)+    (Occurs (Just z) (Just x)) `mappend` (Occurs min max)+                                        = Occurs (Just $ maybe z (*z) min)+                                                 (Just $ maybe x (*x) max)++-- | Push another Occurs value inside an existing Modifier.+combineOccursModifier :: Occurs -> Modifier -> Modifier+combineOccursModifier o Haskell.Single     = occursToModifier $ mappend o+                                                    $ Occurs (Just 1) (Just 1)+combineOccursModifier o Haskell.Optional   = occursToModifier $ mappend o+                                                    $ Occurs (Just 0) (Just 1)+combineOccursModifier o (Haskell.Range o') = occursToModifier $ mappend o o'++-- | Convert an occurs range to a Haskell-style type modifier (Maybe, List, Id)+occursToModifier :: Occurs -> Modifier+occursToModifier (Occurs Nothing  Nothing)  = Haskell.Single+occursToModifier (Occurs (Just 0) Nothing)  = Haskell.Optional+occursToModifier (Occurs (Just 0) (Just 1)) = Haskell.Optional+occursToModifier (Occurs (Just 1) (Just 1)) = Haskell.Single+occursToModifier o                          = Haskell.Range o   -- | Find the supertype (if it exists) of a given type name.

@@ -0,0 +1,6 @@+module Text.XML.HaXml.Version+  ( version+  ) where++version :: String+version  = "1.25.4"

@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#define dummy		-- just to ensure that cpp gets called on this file+#define dummy   -- just to ensure that cpp gets called on this file module Text.XML.HaXml.Wrappers   ( fix2Args   , processXmlWith@@ -20,6 +20,7 @@ import Text.XML.HaXml.Parse       (xmlParse) import Text.XML.HaXml.Html.Parse  (htmlParse) import Text.XML.HaXml.Pretty as PP(document)+import Text.XML.HaXml.Version import Text.PrettyPrint.HughesPJ  (render)  @@ -31,7 +32,7 @@ fix2Args = do   args <- getArgs   when ("--version" `elem` args) $ do-      putStrLn $ "part of HaXml-"++ VERSION+      putStrLn $ "part of HaXml-" ++ version       exitWith ExitSuccess   when ("--help" `elem` args) $ do       putStrLn $ "See http://projects.haskell.org/HaXml"

@@ -71,7 +71,7 @@                            let decls = convert (mkEnvironment inf v emptyEnv) v                                haskl = Haskell.mkModule inf v decls                                doc   = ppModule simpleNameConverter haskl-                           hPutStrLn stdout $ render doc+                           hPutStrLn o $ render doc         (Right v,_)  -> do hPutStrLn stdout $ "Parse incomplete!"                            hPutStrLn stdout $ "\n-----------------\n"                            hPutStrLn stdout $ show v