    -- | A type model for Haskell datatypes that bears a reasonable correspondence
    --   to the XSD type model.
    module Text.XML.HaXml.Schema.HaskellTypeModel
      ( module Text.XML.HaXml.Schema.HaskellTypeModel
      ) where

    import Text.XML.HaXml.Schema.NameConversion
    import Text.XML.HaXml.Schema.XSDTypeModel (Schema(..),Occurs)
    import Text.XML.HaXml.Schema.Parse (lookupBy)
    import Text.XML.HaXml.Types (QName(..),Namespace(..))
    import Data.List (partition)

    -- | Comments can be attached to most things, but not all of them will exist.
    type Comment   = Maybe String

    -- | The whole Haskell module.
    data Module    = Module
                     { Module -> XName
    module_name        :: XName   -- the name of this module
                     , Module -> Maybe XName
    module_xsd_ns      :: Maybe XName -- xmlns:prefix for XSD
                     , Module -> [Decl]
    module_re_exports  :: [Decl]  -- modules imported + exported
                     , Module -> [Decl]
    module_import_only :: [Decl]  -- module + alias
                     , Module -> [Decl]
    module_decls       :: [Decl]  -- the body of the module
                     }

    -- | There are essentially simple types, and complex types, each of which
    --   can be either restricted or extended.  There are four kinds of complex
    --   type: choices, sequences, named groups, or a simple element with content.
    data Decl
                     -- becomes type T = S
                   = NamedSimpleType     XName XName Comment

                     -- becomes newtype T = T S
                     --       + instance Restricts T S where restricts ...
                   | RestrictSimpleType  XName XName [Restrict] Comment

                     -- becomes data T  = T  S Tf
                     --       + data Tf = Tf {fields}
                     --       + instance Extension T S Tf where ...
                   | ExtendSimpleType    XName XName [Attribute] Comment

                     -- becomes data T = Ta S0 | Tb S1 | Tc S2 | ...
                   | UnionSimpleTypes    XName [XName] Comment

                     -- becomes data T = T_C0 | T_C1 | T_C2 | ...
                   | EnumSimpleType      XName [(XName,Comment)] Comment

                     -- becomes data T  = T { singleattr, fields }
                     --   or    data T  = T { manyattr, singlefield }
                     --   or    data T  = T { t_attrs :: Ta, fields }
                     --       + data Ta = Ta { attributes }
                   | ElementsAttrs XName [Element] [Attribute] Comment

                     -- or if T is abstract, it becomes
                     --         data T = T_A  A
                     --                | T_B  B
                     --                | FwdDecl fc c => T_C (fc->c) fc
                     --                | ...
                     --         data FwdC = FwdC -- because C is not yet in scope
                     --         instance FwdDecl FwdC C  -- later, at defn of C
                     --
                     -- In fact, it is better to move the declaration of type C
                     -- here, rather than use a FwdDecl proxy.  This will require
                     -- some patching later where C was originally declared.
                     --         data T = T_A  A
                     --                | T_B  B
                     --                | T_C  C -- but C not yet declared
                     --                | ...
                     --         data C = ... -- because C is not yet in scope
                     --         -- later, at true defn site of C, omit its decl.
                     --
                     -- An earlier solution was
                     --         class T a where parseT :: String -> XMLParser a
                     --         instance T A
                     --         instance T B
                     --         instance T C
                     -- but this is incorrect because the choice between A|B|C
                     -- rests with the input doc, not with the caller of the parser.
                   | ElementsAttrsAbstract {-typename-}XName
                                           {-subtypes-}[(XName,Maybe XName)]
                                    --  ^ [(type name, module where declared later)]
                                           Comment

                     -- becomes function
                     --    elementE :: Parser T
                     --    elementE = parseSchemaType "E"
                   | ElementOfType Element
                     -- or, if E is abstract, with substitutionGroup {Foo,Bar},
                     --    elementE = fmap T_Foo elementFoo `onFail`
                     --               fmap T_Bar elementBar `onFail` ...
                   | ElementAbstractOfType {-element name-}XName
                                           {-abstract type name-}XName
                                           {-substitute elems and fwddecls-}
                                               [(XName,Maybe XName)]
                                           Comment

                     -- becomes (global) data T = E0 e0 | E1 e1 | E2 e2 | E3 e3
                     -- becomes (local)  OneOfN e0 e1 e2 e3
                   | Choice XName [Element] Comment

                     -- becomes data GroupT = GT e0 e1 e2 e3
                   | Group  XName [Element] Comment

          {-         -- becomes data GroupT = GT e0 e1 e2 e3
                   | GroupAttrs XName [Attribute] Comment
          -}
                     -- becomes newtype T = T S
                     --       + different (more restrictive) parser
                   | RestrictComplexType  XName XName Comment

                     -- becomes data T  = T  {fields}
                     --       + instance Extension T S where ...
                     -- or when T extends an _abstract_ XSDtype S, defined in an
                     -- earlier module, it additionally has
                     --        instance FwdDecl FwdT T
                   | ExtendComplexType XName XName [Element] [Attribute]
                                                   [Element] [Attribute]
                                                   {-FwdDecl req'd-}(Maybe XName)
                                                   {-supertype abstract?-}Bool
                                                   {-grandsupertypes-}[XName]
                                                   Comment
                     -- or when T is itself abstract, extending an abstract type S
                     --        class T a where parseT :: String -> XMLParser a
                     --        instance (T a) => S a where parseS = parseT
                   | ExtendComplexTypeAbstract XName XName
                                           {-subtypes-}[(XName,Maybe XName)]
                                           {-FwdDecl instnc req'd-}(Maybe XName)
                                           {-grandsupertypes-}[XName]
                                           Comment

                     -- becomes an import and re-export
                   | XSDInclude XName Comment
                     -- becomes an import only
                   | XSDImport  XName (Maybe XName) Comment
                     -- a top-level annotation
                   | XSDComment Comment
                     deriving (Decl -> Decl -> Bool
    (Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Decl -> Decl -> Bool
    == :: Decl -> Decl -> Bool
    $c/= :: Decl -> Decl -> Bool
    /= :: Decl -> Decl -> Bool
    Eq,Int -> Decl -> ShowS
    [Decl] -> ShowS
    Decl -> [Char]
    (Int -> Decl -> ShowS)
    -> (Decl -> [Char]) -> ([Decl] -> ShowS) -> Show Decl
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Decl -> ShowS
    showsPrec :: Int -> Decl -> ShowS
    $cshow :: Decl -> [Char]
    show :: Decl -> [Char]
    $cshowList :: [Decl] -> ShowS
    showList :: [Decl] -> ShowS
    Show)

    data Element   = Element { Element -> XName
    elem_name     :: XName
                             , Element -> XName
    elem_type     :: XName
                             , Element -> Modifier
    elem_modifier :: Modifier
                             , Element -> Bool
    elem_byRef    :: Bool
                             , Element -> [Decl]
    elem_locals   :: [Decl]
                          -- , elem_abstract :: Bool
                             , Element -> Maybe [XName]
    elem_substs   :: Maybe [XName] -- substitutable elems
                             , Element -> Comment
    elem_comment  :: Comment
                             }
                   | OneOf   { Element -> [[Element]]
    elem_oneOf    :: [[Element]]
                             , elem_modifier :: Modifier
                             , elem_comment  :: Comment
                             }
                   | AnyElem { elem_modifier :: Modifier
                             , elem_comment  :: Comment
                             }
                   | Text -- for mixed content
                     deriving (Element -> Element -> Bool
    (Element -> Element -> Bool)
    -> (Element -> Element -> Bool) -> Eq Element
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Element -> Element -> Bool
    == :: Element -> Element -> Bool
    $c/= :: Element -> Element -> Bool
    /= :: Element -> Element -> Bool
    Eq,Int -> Element -> ShowS
    [Element] -> ShowS
    Element -> [Char]
    (Int -> Element -> ShowS)
    -> (Element -> [Char]) -> ([Element] -> ShowS) -> Show Element
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Element -> ShowS
    showsPrec :: Int -> Element -> ShowS
    $cshow :: Element -> [Char]
    show :: Element -> [Char]
    $cshowList :: [Element] -> ShowS
    showList :: [Element] -> ShowS
    Show)
    data Attribute = Attribute { Attribute -> XName
    attr_name    :: XName
                               , Attribute -> XName
    attr_type    :: XName
                               , Attribute -> Bool
    attr_required:: Bool
                               , Attribute -> Comment
    attr_comment :: Comment
                               }
                     deriving (Attribute -> Attribute -> Bool
    (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Bool) -> Eq Attribute
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Attribute -> Attribute -> Bool
    == :: Attribute -> Attribute -> Bool
    $c/= :: Attribute -> Attribute -> Bool
    /= :: Attribute -> Attribute -> Bool
    Eq,Int -> Attribute -> ShowS
    [Attribute] -> ShowS
    Attribute -> [Char]
    (Int -> Attribute -> ShowS)
    -> (Attribute -> [Char])
    -> ([Attribute] -> ShowS)
    -> Show Attribute
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Attribute -> ShowS
    showsPrec :: Int -> Attribute -> ShowS
    $cshow :: Attribute -> [Char]
    show :: Attribute -> [Char]
    $cshowList :: [Attribute] -> ShowS
    showList :: [Attribute] -> ShowS
    Show)

    data Modifier  = Single
                   | Optional
                   | Range Occurs
                     deriving (Modifier -> Modifier -> Bool
    (Modifier -> Modifier -> Bool)
    -> (Modifier -> Modifier -> Bool) -> Eq Modifier
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Modifier -> Modifier -> Bool
    == :: Modifier -> Modifier -> Bool
    $c/= :: Modifier -> Modifier -> Bool
    /= :: Modifier -> Modifier -> Bool
    Eq,Int -> Modifier -> ShowS
    [Modifier] -> ShowS
    Modifier -> [Char]
    (Int -> Modifier -> ShowS)
    -> (Modifier -> [Char]) -> ([Modifier] -> ShowS) -> Show Modifier
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Modifier -> ShowS
    showsPrec :: Int -> Modifier -> ShowS
    $cshow :: Modifier -> [Char]
    show :: Modifier -> [Char]
    $cshowList :: [Modifier] -> ShowS
    showList :: [Modifier] -> ShowS
    Show)

    -- | Restrictions on simpleType
    data Restrict  = RangeR Occurs Comment
                   | Pattern String{-really Regexp-} Comment
                   | Enumeration [(String,Comment)]
                   | StrLength Occurs Comment
                     deriving (Restrict -> Restrict -> Bool
    (Restrict -> Restrict -> Bool)
    -> (Restrict -> Restrict -> Bool) -> Eq Restrict
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Restrict -> Restrict -> Bool
    == :: Restrict -> Restrict -> Bool
    $c/= :: Restrict -> Restrict -> Bool
    /= :: Restrict -> Restrict -> Bool
    Eq,Int -> Restrict -> ShowS
    [Restrict] -> ShowS
    Restrict -> [Char]
    (Int -> Restrict -> ShowS)
    -> (Restrict -> [Char]) -> ([Restrict] -> ShowS) -> Show Restrict
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Restrict -> ShowS
    showsPrec :: Int -> Restrict -> ShowS
    $cshow :: Restrict -> [Char]
    show :: Restrict -> [Char]
    $cshowList :: [Restrict] -> ShowS
    showList :: [Restrict] -> ShowS
    Show)

    -- | A helper for building the formal Module structure.
    mkModule :: String -> Schema -> [Decl] -> Module
    mkModule :: [Char] -> Schema -> [Decl] -> Module
    mkModule [Char]
    name Schema
    schema [Decl]
    decls =
                          Module { module_name :: XName
    module_name        = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ [Char] -> QName
    N [Char]
    name
                                 , module_xsd_ns :: Maybe XName
    module_xsd_ns      = [Namespace] -> Maybe XName
    xsdQualification
                                                          (Schema -> [Namespace]
    schema_namespaces Schema
    schema)
                                 , module_re_exports :: [Decl]
    module_re_exports  = [Decl]
    reexports
                                 , module_import_only :: [Decl]
    module_import_only = [Decl]
    imports
                                 , module_decls :: [Decl]
    module_decls       = [Decl]
    theRest
                                 }
        where ([Decl]
    reexports,[Decl]
    other)   = (Decl -> Bool) -> [Decl] -> ([Decl], [Decl])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Decl -> Bool
    xsdinclude [Decl]
    decls
              ([Decl]
    imports,  [Decl]
    theRest) = (Decl -> Bool) -> [Decl] -> ([Decl], [Decl])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Decl -> Bool
    xsdimport  [Decl]
    other
              xsdinclude :: Decl -> Bool
    xsdinclude (XSDInclude XName
    _ Comment
    _)  = Bool
    True
              xsdinclude Decl
    _                 = Bool
    False
              xsdimport :: Decl -> Bool
    xsdimport  (XSDImport XName
    _ Maybe XName
    _ Comment
    _) = Bool
    True
              xsdimport  Decl
    _                 = Bool
    False
              xsdQualification :: [Namespace] -> Maybe XName
    xsdQualification [Namespace]
    nss = QName -> XName
    XName (QName -> XName) -> (Namespace -> QName) -> Namespace -> XName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> QName
    N ([Char] -> QName) -> (Namespace -> [Char]) -> Namespace -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Namespace -> [Char]
    nsPrefix (Namespace -> XName) -> Maybe Namespace -> Maybe XName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                          (Namespace -> Bool) -> [Namespace] -> Maybe Namespace
    forall a. (a -> Bool) -> [a] -> Maybe a
    lookupBy (([Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    ==[Char]
    xsd)([Char] -> Bool) -> (Namespace -> [Char]) -> Namespace -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Namespace -> [Char]
    nsURI) [Namespace]
    nss
                  where xsd :: [Char]
    xsd = [Char]
    "http://www.w3.org/2001/XMLSchema"