    {-# LANGUAGE PatternGuards #-}
    module Text.XML.HaXml.Schema.TypeConversion
      ( module Text.XML.HaXml.Schema.TypeConversion
      ) where

    import Text.XML.HaXml.Types (QName(..),Name(..),Namespace(..))
    import Text.XML.HaXml.Namespaces (printableName,localName)
    import Text.XML.HaXml.Schema.Environment
    import Text.XML.HaXml.Schema.XSDTypeModel     as XSD
    import Text.XML.HaXml.Schema.HaskellTypeModel as Haskell
    import Text.XML.HaXml.Schema.NameConversion
    import Text.XML.HaXml.Schema.Parse (xsd)

    import qualified Data.Map as Map
    import Data.Semigroup (Semigroup (..))
    import Data.Map (Map)
    import Data.List (foldl')
    import Data.Maybe (fromMaybe,fromJust,isNothing,isJust)
    import Data.Monoid (Monoid (..))

    -- | Transform a Schema by lifting all locally-defined anonymous types to
    --   the top-level, naming them, and planting a referend at their original
    --   location.
    typeLift :: Schema -> Schema
    typeLift :: Schema -> Schema
    typeLift Schema
    s = Schema
    s{ schema_items =
                        concat [ hoist e | SchemaElement e <- schema_items s ]
                        ++ map renameLocals (schema_items s) }
      where
        hoist :: ElementDecl -> [SchemaItem]
        hoist :: ElementDecl -> [SchemaItem]
    hoist ElementDecl
    e =
                  let only_children :: [ElementDecl]
    only_children = (ElementDecl -> Bool) -> [ElementDecl] -> [ElementDecl]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (ElementDecl -> Bool) -> ElementDecl -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ElementDecl -> ElementDecl -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ElementDecl
    e) ([ElementDecl] -> [ElementDecl]) -> [ElementDecl] -> [ElementDecl]
    forall a b. (a -> b) -> a -> b
    $ ElementDecl -> [ElementDecl]
    findE ElementDecl
    e
                  in ((ElementDecl -> [SchemaItem]) -> [ElementDecl] -> [SchemaItem])
    -> [ElementDecl] -> (ElementDecl -> [SchemaItem]) -> [SchemaItem]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (ElementDecl -> [SchemaItem]) -> [ElementDecl] -> [SchemaItem]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [ElementDecl]
    only_children ((ElementDecl -> [SchemaItem]) -> [SchemaItem])
    -> (ElementDecl -> [SchemaItem]) -> [SchemaItem]
    forall a b. (a -> b) -> a -> b
    $
                  \e :: ElementDecl
    e@ElementDecl{elem_nameOrRef :: ElementDecl -> Either NameAndType QName
    elem_nameOrRef=Left (NT{ theName :: NameAndType -> String
    theName=String
    n
                                                      {-, theType=Nothing-}})}->
                      String -> Maybe (Either SimpleType ComplexType) -> [SchemaItem]
    localType String
    n (ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    e)

        findE :: ElementDecl -> [ElementDecl]
        findE :: ElementDecl -> [ElementDecl]
    findE ElementDecl
    e = ( case ElementDecl -> Either NameAndType QName
    elem_nameOrRef ElementDecl
    e of
                      Left (NT{theType :: NameAndType -> Maybe QName
    theType=Maybe QName
    Nothing}) -> (ElementDecl
    eElementDecl -> [ElementDecl] -> [ElementDecl]
    forall a. a -> [a] -> [a]
    :)
                      Left (NT{theType :: NameAndType -> Maybe QName
    theType=Just QName
    t})  -> case ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    e of
                                                      Just (Right
                                                        (ComplexType
                                                           {complex_name :: ComplexType -> Maybe String
    complex_name=Just String
    t'}))
                                                     {--| t==t'-}
                                                        -> (ElementDecl
    eElementDecl -> [ElementDecl] -> [ElementDecl]
    forall a. a -> [a] -> [a]
    :)
                                                      Maybe (Either SimpleType ComplexType)
    _ -> [ElementDecl] -> [ElementDecl]
    forall a. a -> a
    id
                      Either NameAndType QName
    _                          -> [ElementDecl] -> [ElementDecl]
    forall a. a -> a
    id
                  )
                  ( case ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    e of
                      Maybe (Either SimpleType ComplexType)
    Nothing        -> []
                      Just (Left  SimpleType
    _) -> []
                      Just (Right ComplexType
    c) ->
                        case ComplexType -> ComplexItem
    complex_content ComplexType
    c of
                          v :: ComplexItem
    v@SimpleContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
    ci_stuff=Left (Restriction1 Particle
    p)} -> Particle -> [ElementDecl]
    particle Particle
    p
                          v :: ComplexItem
    v@SimpleContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
    ci_stuff=Right (Extension{extension_newstuff :: Extension -> ParticleAttrs
    extension_newstuff=PA Particle
    p [Either AttributeDecl AttrGroup]
    _ Maybe AnyAttr
    _})} -> Particle -> [ElementDecl]
    particle Particle
    p
                          v :: ComplexItem
    v@ComplexContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
    ci_stuff=Left (Restriction1 Particle
    p)} -> Particle -> [ElementDecl]
    particle Particle
    p
                          v :: ComplexItem
    v@ComplexContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
    ci_stuff=Right (Extension{extension_newstuff :: Extension -> ParticleAttrs
    extension_newstuff=PA Particle
    p [Either AttributeDecl AttrGroup]
    _ Maybe AnyAttr
    _})} -> Particle -> [ElementDecl]
    particle Particle
    p
                          v :: ComplexItem
    v@ThisType{ci_thistype :: ComplexItem -> ParticleAttrs
    ci_thistype=PA Particle
    p [Either AttributeDecl AttrGroup]
    _ Maybe AnyAttr
    _} -> Particle -> [ElementDecl]
    particle Particle
    p
                  )
        particle :: Particle -> [ElementDecl]
    particle Particle
    Nothing = []
        particle (Just (Left ChoiceOrSeq
    cos)) = ChoiceOrSeq -> [ElementDecl]
    choiceOrSeq ChoiceOrSeq
    cos
        particle (Just (Right Group
    g))  = [ElementDecl]
    -> (ChoiceOrSeq -> [ElementDecl])
    -> Maybe ChoiceOrSeq
    -> [ElementDecl]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ChoiceOrSeq -> [ElementDecl]
    choiceOrSeq (Maybe ChoiceOrSeq -> [ElementDecl])
    -> Maybe ChoiceOrSeq -> [ElementDecl]
    forall a b. (a -> b) -> a -> b
    $ Group -> Maybe ChoiceOrSeq
    group_stuff Group
    g
        choiceOrSeq :: ChoiceOrSeq -> [ElementDecl]
    choiceOrSeq (XSD.All Annotation
    _ [ElementDecl]
    es)        = (ElementDecl -> [ElementDecl]) -> [ElementDecl] -> [ElementDecl]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ElementDecl -> [ElementDecl]
    findE [ElementDecl]
    es
        choiceOrSeq (XSD.Choice   Annotation
    _ Occurs
    _ [ElementEtc]
    es) = (ElementEtc -> [ElementDecl]) -> [ElementEtc] -> [ElementDecl]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ElementEtc -> [ElementDecl]
    etc [ElementEtc]
    es
        choiceOrSeq (XSD.Sequence Annotation
    _ Occurs
    _ [ElementEtc]
    es) = (ElementEtc -> [ElementDecl]) -> [ElementEtc] -> [ElementDecl]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ElementEtc -> [ElementDecl]
    etc [ElementEtc]
    es
        etc :: ElementEtc -> [ElementDecl]
    etc (HasElement ElementDecl
    e) = ElementDecl -> [ElementDecl]
    findE ElementDecl
    e
        etc (HasGroup Group
    g)   = [ElementDecl]
    -> (ChoiceOrSeq -> [ElementDecl])
    -> Maybe ChoiceOrSeq
    -> [ElementDecl]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] ChoiceOrSeq -> [ElementDecl]
    choiceOrSeq (Maybe ChoiceOrSeq -> [ElementDecl])
    -> Maybe ChoiceOrSeq -> [ElementDecl]
    forall a b. (a -> b) -> a -> b
    $ Group -> Maybe ChoiceOrSeq
    group_stuff Group
    g
        etc (HasCS ChoiceOrSeq
    cos)    = ChoiceOrSeq -> [ElementDecl]
    choiceOrSeq ChoiceOrSeq
    cos
        etc (HasAny Any
    _)     = []

        localType :: String -> Maybe (Either SimpleType ComplexType) -> [SchemaItem]
    localType String
    n Maybe (Either SimpleType ComplexType)
    Nothing          = []
        localType String
    n (Just (Left SimpleType
    s))  = [SimpleType -> SchemaItem
    Simple  (String -> SimpleType -> SimpleType
    renameSimple String
    n SimpleType
    s)]
        localType String
    n (Just (Right ComplexType
    c)) = [ComplexType -> SchemaItem
    Complex ComplexType
    c{ complex_name = Just n }]

        renameSimple :: String -> SimpleType -> SimpleType
    renameSimple String
    n s :: SimpleType
    s@Primitive{}  = SimpleType
    s
        renameSimple String
    n s :: SimpleType
    s@Restricted{} = SimpleType
    s{ simple_name  = Just n }
        renameSimple String
    n s :: SimpleType
    s@ListOf{}     = SimpleType
    s{ simple_name  = Just n }
        renameSimple String
    n s :: SimpleType
    s@UnionOf{}    = SimpleType
    s{ simple_name  = Just n }

        -- * For now, rather than walk the tree, giving typenames to nodes that were
        --   previously locally-typed, we will instead assume in the pretty-printer
        --   that it can always replace a missing typename with the element name, and
        --   have it resolve to something sensible.
        renameLocals :: SchemaItem -> SchemaItem
        renameLocals :: SchemaItem -> SchemaItem
    renameLocals SchemaItem
    s = SchemaItem
    s
    --  renameLocals (SchemaElement e)
    --                 | Left (NT{theName=n,theType=Nothing}) <- elem_nameOrRef e
    --                 = SchemaElement e{ elem_nameOrRef = Left (NT{theName=n
    --                                                             ,theType=Just n})
    --                                  }
    --            -- still gotta do the recursive search + rename

    -- | Given an environment of schema type mappings, and a schema module,
    --   create a bunch of Decls that describe the types in a more
    --   Haskell-friendly way.
    convert :: Environment -> Schema -> [Haskell.Decl]
    convert :: Environment -> Schema -> [Decl]
    convert Environment
    env Schema
    s = (SchemaItem -> [Decl]) -> [SchemaItem] -> [Decl]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap SchemaItem -> [Decl]
    item (Schema -> [SchemaItem]
    schema_items Schema
    s)
      where
        item :: SchemaItem -> [Decl]
    item (Include String
    loc Annotation
    ann)    = [XName -> Maybe String -> Decl
    XSDInclude (String -> XName
    xname String
    loc) (Annotation -> Maybe String
    comment Annotation
    ann)]
        item (Import String
    uri String
    loc Annotation
    ann) = [XName -> Maybe XName -> Maybe String -> Decl
    XSDImport  (String -> XName
    xname String
    loc)
                                                (String -> XName
    xname (String -> XName) -> Maybe String -> Maybe XName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                                 String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    uri (Environment -> Map String String
    env_namespace Environment
    env))
                                                (Annotation -> Maybe String
    comment Annotation
    ann)]
        item (Redefine String
    _ [SchemaItem]
    _)       = [] -- ignoring redefinitions for now
        item (Annotation Annotation
    ann)     = [Maybe String -> Decl
    XSDComment (Annotation -> Maybe String
    comment Annotation
    ann)]
        item (Simple SimpleType
    st)          = SimpleType -> [Decl]
    simple SimpleType
    st
        item (Complex ComplexType
    ct)         = ComplexType -> [Decl]
    complex ComplexType
    ct
        item (SchemaElement ElementDecl
    ed)   = ElementDecl -> [Decl]
    topElementDecl ElementDecl
    ed
        item (SchemaAttribute AttributeDecl
    ad) = [] -- attributeDecl ad
        item (AttributeGroup AttrGroup
    ag)  = [] -- attrgroup ag
        item (SchemaGroup Group
    g)      = Group -> [Decl]
    group Group
    g

        simple :: SimpleType -> [Decl]
    simple (Primitive PrimitiveType
    prim)     = []
        simple s :: SimpleType
    s@(Restricted Annotation
    a Maybe String
    n Maybe Final
    f Restriction
    r)
            | (Just [(XName, Maybe String)]
    enums) <- SimpleType -> Maybe [(XName, Maybe String)]
    isEnumeration SimpleType
    s
                                    = [XName -> [(XName, Maybe String)] -> Maybe String -> Decl
    EnumSimpleType
                                           (XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    forall a. HasCallStack => String -> a
    error String
    "missing Name") String -> XName
    xname Maybe String
    n)
                                           [(XName, Maybe String)]
    enums (Annotation -> Maybe String
    comment Annotation
    a) ]
            | Bool
    otherwise             = [XName -> XName -> [Restrict] -> Maybe String -> Decl
    RestrictSimpleType
                                           (XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    forall a. HasCallStack => String -> a
    error String
    "missing Name") String -> XName
    xname Maybe String
    n)
                                           (XName -> (QName -> XName) -> Maybe QName -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    xname String
    "unknownSimple") QName -> XName
    XName
                                                                 (Restriction -> Maybe QName
    restrict_base Restriction
    r))
                                           (Restriction -> [Restrict]
    mkRestrict Restriction
    r)
                                           (Annotation -> Maybe String
    comment Annotation
    a)]
        simple (ListOf Annotation
    a Maybe String
    n Maybe Final
    f Either SimpleType QName
    t)     = String -> [Decl]
    forall a. HasCallStack => String -> a
    error String
    "Not yet implemented: ListOf simpleType"
                                  --  [NamedSimpleType    (xname n) (nameOfSimple s)
                                  --                      (comment a)]
        simple s :: SimpleType
    s@(UnionOf Annotation
    a Maybe String
    n Maybe Final
    f [SimpleType]
    u [QName]
    m)
            | (Just [(XName, Maybe String)]
    enums) <- SimpleType -> Maybe [(XName, Maybe String)]
    isEnumeration SimpleType
    s
                                    = [XName -> [(XName, Maybe String)] -> Maybe String -> Decl
    EnumSimpleType
                                           (XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    forall a. HasCallStack => String -> a
    error String
    "missing Name") String -> XName
    xname Maybe String
    n)
                                           [(XName, Maybe String)]
    enums (Annotation -> Maybe String
    comment Annotation
    a) ]
            | Bool
    otherwise             = [XName -> [XName] -> Maybe String -> Decl
    UnionSimpleTypes
                                           (XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    forall a. HasCallStack => String -> a
    error String
    "missing Name") String -> XName
    xname Maybe String
    n)
                                           ((QName -> XName) -> [QName] -> [XName]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> XName
    xname (String -> XName) -> (QName -> String) -> QName -> XName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    printableName) [QName]
    m) -- XXX ignores content 'u'
                                           (Annotation -> Maybe String
    comment Annotation
    a)]

        isEnumeration :: SimpleType -> Maybe [(XName,Comment)]
        isEnumeration :: SimpleType -> Maybe [(XName, Maybe String)]
    isEnumeration (Primitive PrimitiveType
    _)        = Maybe [(XName, Maybe String)]
    forall a. Maybe a
    Nothing
        isEnumeration (ListOf Annotation
    _ Maybe String
    _ Maybe Final
    _ Either SimpleType QName
    _)     = Maybe [(XName, Maybe String)]
    forall a. Maybe a
    Nothing
        isEnumeration (Restricted Annotation
    _ Maybe String
    _ Maybe Final
    _ Restriction
    r) =
            case Restriction
    r of
                RestrictSim1 Annotation
    ann Maybe QName
    base Restriction1
    r1  -> Maybe [(XName, Maybe String)]
    forall a. Maybe a
    Nothing
                RestrictType Annotation
    _ Maybe QName
    _ Maybe SimpleType
    _ [Facet]
    facets ->
                    let enum :: [(XName, Maybe String)]
    enum = [ (String -> XName
    xname String
    v, Annotation -> Maybe String
    comment Annotation
    ann)
                               | (Facet FacetType
    UnorderedEnumeration Annotation
    ann String
    v Bool
    _) <- [Facet]
    facets ]
                    in if [(XName, Maybe String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(XName, Maybe String)]
    enum then Maybe [(XName, Maybe String)]
    forall a. Maybe a
    Nothing else [(XName, Maybe String)] -> Maybe [(XName, Maybe String)]
    forall a. a -> Maybe a
    Just [(XName, Maybe String)]
    enum
        isEnumeration (UnionOf Annotation
    _ Maybe String
    _ Maybe Final
    _ [SimpleType]
    u [QName]
    ms) =
            [(XName, Maybe String)]
    -> [Maybe [(XName, Maybe String)]] -> Maybe [(XName, Maybe String)]
    forall {a}. [a] -> [Maybe [a]] -> Maybe [a]
    squeeze [] ( ((QName -> Maybe [(XName, Maybe String)])
     -> [QName] -> [Maybe [(XName, Maybe String)]])
    -> [QName]
    -> (QName -> Maybe [(XName, Maybe String)])
    -> [Maybe [(XName, Maybe String)]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (QName -> Maybe [(XName, Maybe String)])
    -> [QName] -> [Maybe [(XName, Maybe String)]]
    forall a b. (a -> b) -> [a] -> [b]
    map [QName]
    ms (\QName
    m-> case QName
    -> Map QName (Either SimpleType ComplexType)
    -> Maybe (Either SimpleType ComplexType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    m (Environment -> Map QName (Either SimpleType ComplexType)
    env_type Environment
    env) of
                                             Just (Left SimpleType
    s)-> SimpleType -> Maybe [(XName, Maybe String)]
    isEnumeration SimpleType
    s
                                             Maybe (Either SimpleType ComplexType)
    _            -> Maybe [(XName, Maybe String)]
    forall a. Maybe a
    Nothing)
                         [Maybe [(XName, Maybe String)]]
    -> [Maybe [(XName, Maybe String)]]
    -> [Maybe [(XName, Maybe String)]]
    forall a. [a] -> [a] -> [a]
    ++ (SimpleType -> Maybe [(XName, Maybe String)])
    -> [SimpleType] -> [Maybe [(XName, Maybe String)]]
    forall a b. (a -> b) -> [a] -> [b]
    map SimpleType -> Maybe [(XName, Maybe String)]
    isEnumeration [SimpleType]
    u )
            where squeeze :: [a] -> [Maybe [a]] -> Maybe [a]
    squeeze [a]
    _  (Maybe [a]
    Nothing:[Maybe [a]]
    _)    = Maybe [a]
    forall a. Maybe a
    Nothing
                  squeeze [a]
    xs (Just [a]
    ys:[Maybe [a]]
    rest) = [a] -> [Maybe [a]] -> Maybe [a]
    squeeze ([a]
    xs[a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++[a]
    ys) [Maybe [a]]
    rest
                  squeeze [a]
    xs []             = [a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    xs

        complex :: ComplexType -> [Decl]
    complex ComplexType
    ct =
          let nx :: QName
    nx  = String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "errorMissingName" (ComplexType -> Maybe String
    complex_name ComplexType
    ct)
              n :: XName
    n   = QName -> XName
    XName QName
    nx
          in Decl -> [Decl]
    forall a. a -> [a]
    singleton (Decl -> [Decl]) -> Decl -> [Decl]
    forall a b. (a -> b) -> a -> b
    $
          case ComplexType -> ComplexItem
    complex_content ComplexType
    ct of
            c :: ComplexItem
    c@SimpleContent{}  ->
                case ComplexItem -> Either Restriction1 Extension
    ci_stuff ComplexItem
    c of
                    Left Restriction1
    r  ->
                        XName -> XName -> [Restrict] -> Maybe String -> Decl
    RestrictSimpleType XName
    n ({-simple-}String -> XName
    xname String
    "Unimplemented") []
                                         (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct
                                                  Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` ComplexItem -> Annotation
    ci_annotation ComplexItem
    c))
                    Right Extension
    e ->
                        XName -> XName -> [Attribute] -> Maybe String -> Decl
    ExtendSimpleType XName
    n
                                         ({-supertype-}QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ Extension -> QName
    extension_base Extension
    e)
                                         ({-attrs-}([Element], [Attribute]) -> [Attribute]
    forall a b. (a, b) -> b
    snd (([Element], [Attribute]) -> [Attribute])
    -> ([Element], [Attribute]) -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $
                                          ParticleAttrs -> ([Element], [Attribute])
    particleAttrs (ParticleAttrs -> ([Element], [Attribute]))
    -> ParticleAttrs -> ([Element], [Attribute])
    forall a b. (a -> b) -> a -> b
    $ Extension -> ParticleAttrs
    extension_newstuff Extension
    e)
                                         (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct
                                                  Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` ComplexItem -> Annotation
    ci_annotation ComplexItem
    c
                                                  Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` Extension -> Annotation
    extension_annotation Extension
    e))
            c :: ComplexItem
    c@ComplexContent{} ->
                case ComplexItem -> Either Restriction1 Extension
    ci_stuff ComplexItem
    c of
                    Left Restriction1
    r  ->
                        XName -> XName -> Maybe String -> Decl
    RestrictComplexType XName
    n ({-complex-}String -> XName
    xname String
    "Can'tBeRight")
                                         (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct
                                                  Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` ComplexItem -> Annotation
    ci_annotation ComplexItem
    c))
                    Right Extension
    e ->
                        let myLoc :: String
    myLoc  = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "NUL" (QName -> Map QName String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nx
                                                                 (Environment -> Map QName String
    env_typeloc Environment
    env))
                            supLoc :: String
    supLoc = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "NUL" (QName -> Map QName String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Extension -> QName
    extension_base Extension
    e)
                                                                 (Environment -> Map QName String
    env_typeloc Environment
    env))
                        in
                        if ComplexType -> Bool
    complex_abstract ComplexType
    ct then
                            XName
    -> XName
    -> [(XName, Maybe XName)]
    -> Maybe XName
    -> [XName]
    -> Maybe String
    -> Decl
    ExtendComplexTypeAbstract XName
    n
                                 ({-supertype-}QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ Extension -> QName
    extension_base Extension
    e)
                                 ({-subtypes-}
                                  [(XName, Maybe XName)]
    -> ([(QName, String)] -> [(XName, Maybe XName)])
    -> Maybe [(QName, String)]
    -> [(XName, Maybe XName)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> [(XName, Maybe XName)]
    forall a. HasCallStack => String -> a
    error (String
    "ExtendComplexTypeAbstract "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    forall a. Show a => a -> String
    show QName
    nx))
                                        (((QName, String) -> (XName, Maybe XName))
    -> [(QName, String)] -> [(XName, Maybe XName)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(QName
    t,String
    l)->(QName -> XName
    XName QName
    t,if String
    lString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    myLoc
                                                               then XName -> Maybe XName
    forall a. a -> Maybe a
    Just (String -> XName
    xname String
    l)
                                                               else Maybe XName
    forall a. Maybe a
    Nothing)))
                                        (QName -> Map QName [(QName, String)] -> Maybe [(QName, String)]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nx (Environment -> Map QName [(QName, String)]
    env_extendty Environment
    env)))
                                 ({-fwddecl-}if String
    myLocString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    supLoc
                                             then XName -> Maybe XName
    forall a. a -> Maybe a
    Just (String -> XName
    xname String
    supLoc) else Maybe XName
    forall a. Maybe a
    Nothing)
                                 ({-grandsupers-}
                                  (QName -> XName) -> [QName] -> [XName]
    forall a b. (a -> b) -> [a] -> [b]
    map QName -> XName
    XName ([QName] -> [XName]) -> [QName] -> [XName]
    forall a b. (a -> b) -> a -> b
    $ (QName -> Maybe QName) -> QName -> [QName]
    forall a. (a -> Maybe a) -> a -> [a]
    repeatedly (Environment -> QName -> Maybe QName
    supertypeOf Environment
    env) QName
    nx)
                                 (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct
                                          Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` ComplexItem -> Annotation
    ci_annotation ComplexItem
    c
                                          Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` Extension -> Annotation
    extension_annotation Extension
    e))
                        else
                        let ([Element]
    es,[Attribute]
    as) = ParticleAttrs -> ([Element], [Attribute])
    particleAttrs (Extension -> ParticleAttrs
    extension_newstuff Extension
    e)
                            es' :: [Element]
    es'     | ComplexItem -> Bool
    ci_mixed ComplexItem
    c = [Element] -> [Element]
    mkMixedContent [Element]
    es
                                    | Bool
    otherwise  = [Element]
    es
                            ([Element]
    oldEs,[Attribute]
    oldAs) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
    contentInfo (Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute]))
    -> Maybe (Either SimpleType ComplexType)
    -> ([Element], [Attribute])
    forall a b. (a -> b) -> a -> b
    $
                                                QName
    -> Map QName (Either SimpleType ComplexType)
    -> Maybe (Either SimpleType ComplexType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Extension -> QName
    extension_base Extension
    e)
                                                           (Environment -> Map QName (Either SimpleType ComplexType)
    env_type Environment
    env)
                        in
                        XName
    -> XName
    -> [Element]
    -> [Attribute]
    -> [Element]
    -> [Attribute]
    -> Maybe XName
    -> Bool
    -> [XName]
    -> Maybe String
    -> Decl
    ExtendComplexType XName
    n
                            ({-supertype-}QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ Extension -> QName
    extension_base Extension
    e)
                            {-supertype elems-}[Element]
    oldEs
                            {-supertype attrs-}[Attribute]
    oldAs
                            {-elems-}[Element]
    es
                            {-attrs-}[Attribute]
    as
                            ({-fwddecl-}if String
    myLocString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    supLoc then XName -> Maybe XName
    forall a. a -> Maybe a
    Just (String -> XName
    xname String
    supLoc)
                                                         else Maybe XName
    forall a. Maybe a
    Nothing)
                            ({-abstract supertype-}
                             Bool
    -> (Either SimpleType ComplexType -> Bool)
    -> Maybe (Either SimpleType ComplexType)
    -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False ((SimpleType -> Bool)
    -> (ComplexType -> Bool) -> Either SimpleType ComplexType -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Bool -> SimpleType -> Bool
    forall a b. a -> b -> a
    const Bool
    False) ComplexType -> Bool
    complex_abstract)
                                         (QName
    -> Map QName (Either SimpleType ComplexType)
    -> Maybe (Either SimpleType ComplexType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Extension -> QName
    extension_base Extension
    e)
                                                     (Environment -> Map QName (Either SimpleType ComplexType)
    env_type Environment
    env)))
                            ({-grandsupers-}
                             (QName -> XName) -> [QName] -> [XName]
    forall a b. (a -> b) -> [a] -> [b]
    map QName -> XName
    XName ([QName] -> [XName]) -> [QName] -> [XName]
    forall a b. (a -> b) -> a -> b
    $ (QName -> Maybe QName) -> QName -> [QName]
    forall a. (a -> Maybe a) -> a -> [a]
    repeatedly (Environment -> QName -> Maybe QName
    supertypeOf Environment
    env)
                                       (QName -> [QName]) -> QName -> [QName]
    forall a b. (a -> b) -> a -> b
    $ Extension -> QName
    extension_base Extension
    e)
                            (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct
                                     Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` ComplexItem -> Annotation
    ci_annotation ComplexItem
    c
                                     Annotation -> Annotation -> Annotation
    forall a. Monoid a => a -> a -> a
    `mappend` Extension -> Annotation
    extension_annotation Extension
    e))
            c :: ComplexItem
    c@ThisType{} | ComplexType -> Bool
    complex_abstract ComplexType
    ct ->
                let myLoc :: String
    myLoc  = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "NUL"
                             (QName -> Map QName String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nx (Environment -> Map QName String
    env_typeloc Environment
    env)) in
                XName -> [(XName, Maybe XName)] -> Maybe String -> Decl
    ElementsAttrsAbstract XName
    n
                              {-all instance types: -}
                              (case QName -> Map QName [(QName, String)] -> Maybe [(QName, String)]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nx (Environment -> Map QName [(QName, String)]
    env_extendty Environment
    env) of
                                 Maybe [(QName, String)]
    Nothing -> []
                                 Just [(QName, String)]
    xs -> ((QName, String) -> (XName, Maybe XName))
    -> [(QName, String)] -> [(XName, Maybe XName)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    x,String
    loc)->(QName -> XName
    XName QName
    x,if String
    locString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    myLoc
                                                              then XName -> Maybe XName
    forall a. a -> Maybe a
    Just (String -> XName
    xname String
    loc)
                                                              else Maybe XName
    forall a. Maybe a
    Nothing)) [(QName, String)]
    xs
                              )
                              (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct))
            c :: ComplexItem
    c@ThisType{} | Bool
    otherwise ->
                let ([Element]
    es,[Attribute]
    as) = ParticleAttrs -> ([Element], [Attribute])
    particleAttrs (ComplexItem -> ParticleAttrs
    ci_thistype ComplexItem
    c)
                    es' :: [Element]
    es'     | ComplexType -> Bool
    complex_mixed ComplexType
    ct = [Element] -> [Element]
    mkMixedContent [Element]
    es
                            | Bool
    otherwise        = [Element]
    es
                in
                XName -> [Element] -> [Attribute] -> Maybe String -> Decl
    ElementsAttrs XName
    n [Element]
    es' [Attribute]
    as (Annotation -> Maybe String
    comment (ComplexType -> Annotation
    complex_annotation ComplexType
    ct))

        mkMixedContent :: [Element] -> [Element]
    mkMixedContent [e :: Element
    e@OneOf{}] = [Element
    e{ elem_oneOf = [Text]: elem_oneOf e }]
        mkMixedContent [Element]
    es          = Element
    TextElement -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : (Element -> [Element]) -> [Element] -> [Element]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\Element
    e->[Element
    e,Element
    Text]) [Element]
    es

        topElementDecl :: XSD.ElementDecl -> [Haskell.Decl]
        topElementDecl :: ElementDecl -> [Decl]
    topElementDecl ElementDecl
    ed = case ElementDecl -> Either NameAndType QName
    elem_nameOrRef ElementDecl
    ed of
            Left  NameAndType
    n   -> case NameAndType -> Maybe QName
    theType NameAndType
    n of
                           Maybe QName
    Nothing ->
                           --error "Not implemented: contentInfo on topElementDecl"
                           --I'm pretty sure a topElementDecl can't be abstract...
                             let ([Element]
    es,[Attribute]
    as) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
    contentInfo (ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    ed) in
                             [ XName -> [Element] -> [Attribute] -> Maybe String -> Decl
    ElementsAttrs ({-name-}String -> XName
    xname (String -> XName) -> String -> XName
    forall a b. (a -> b) -> a -> b
    $ NameAndType -> String
    theName NameAndType
    n)
                                             {-elems-}[Element]
    es
                                             {-attrs-}[Attribute]
    as
                                             (Annotation -> Maybe String
    comment (ElementDecl -> Annotation
    elem_annotation ElementDecl
    ed))
                             , Element -> Decl
    ElementOfType (Element -> Decl) -> Element -> Decl
    forall a b. (a -> b) -> a -> b
    $ ElementDecl -> Element
    elementDecl ElementDecl
    ed
                               --  Element{ elem_name = xname (theName n)
                               --         , elem_type = checkXName s (N $ theName n)
                               --         , elem_modifier =
                               --                 occursToModifier (elem_occurs ed)
                               --         , elem_byRef   = False
                               --         , elem_locals  = []
                               --         , elem_substs  = Nothing
                               --         , elem_comment =
                               --                     (comment (elem_annotation ed))
                               --         }
                             ]
                           Just QName
    t | ElementDecl -> Bool
    elem_abstract ElementDecl
    ed ->
                             let nm :: QName
    nm     = String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ NameAndType -> String
    theName NameAndType
    n
                                 myLoc :: String
    myLoc  = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "NUL"
                                              (QName -> Map QName String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nm (Environment -> Map QName String
    env_typeloc Environment
    env)) in
                             Decl -> [Decl]
    forall a. a -> [a]
    singleton (Decl -> [Decl]) -> Decl -> [Decl]
    forall a b. (a -> b) -> a -> b
    $
                             XName -> XName -> [(XName, Maybe XName)] -> Maybe String -> Decl
    ElementAbstractOfType
                                     (QName -> XName
    XName QName
    nm)
                                     (Schema -> QName -> XName
    checkXName Schema
    s QName
    t)
                                     (case QName -> Map QName [(QName, String)] -> Maybe [(QName, String)]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    nm (Environment -> Map QName [(QName, String)]
    env_substGrp Environment
    env) of
                                        Maybe [(QName, String)]
    Nothing -> []
                                        Just [(QName, String)]
    xs ->
                                          ((QName, String) -> (XName, Maybe XName))
    -> [(QName, String)] -> [(XName, Maybe XName)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    x,String
    loc)->(QName -> XName
    XName QName
    x,
                                                           if String
    locString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /=String
    myLoc
                                                           then XName -> Maybe XName
    forall a. a -> Maybe a
    Just (String -> XName
    xname String
    loc)
                                                           else Maybe XName
    forall a. Maybe a
    Nothing)) [(QName, String)]
    xs)
                                     (Annotation -> Maybe String
    comment (ElementDecl -> Annotation
    elem_annotation ElementDecl
    ed))
                           Just QName
    t | Bool
    otherwise ->
                             Decl -> [Decl]
    forall a. a -> [a]
    singleton (Decl -> [Decl]) -> Decl -> [Decl]
    forall a b. (a -> b) -> a -> b
    $ Element -> Decl
    ElementOfType (Element -> Decl) -> Element -> Decl
    forall a b. (a -> b) -> a -> b
    $ ElementDecl -> Element
    elementDecl ElementDecl
    ed
                         --  Element{ elem_name    = xname $ theName n
                         --         , elem_type    = checkXName s t
                         --         , elem_modifier=
                         --                       occursToModifier (elem_occurs ed)
                         --         , elem_byRef   = False
                         --         , elem_locals  = []
                         --         , elem_substs  = Nothing
                         --         , elem_comment = comment (elem_annotation ed)
                         --         }
            Right QName
    ref -> case QName -> Map QName ElementDecl -> Maybe ElementDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    ref (Environment -> Map QName ElementDecl
    env_element Environment
    env) of
               Maybe ElementDecl
    Nothing -> String -> [Decl]
    forall a. HasCallStack => String -> a
    error (String -> [Decl]) -> String -> [Decl]
    forall a b. (a -> b) -> a -> b
    $ String
    "<topElementDecl> unknown element reference "
                                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    printableName QName
    ref
               Just ElementDecl
    e' -> ElementDecl -> [Decl]
    topElementDecl ElementDecl
    e'

        elementDecl :: XSD.ElementDecl -> Haskell.Element
        elementDecl :: ElementDecl -> Element
    elementDecl ElementDecl
    ed = case ElementDecl -> Either NameAndType QName
    elem_nameOrRef ElementDecl
    ed of
            Left  NameAndType
    n   -> Element { elem_name :: XName
    elem_name     = String -> XName
    xname (String -> XName) -> String -> XName
    forall a b. (a -> b) -> a -> b
    $ NameAndType -> String
    theName NameAndType
    n
                                 , elem_type :: XName
    elem_type     = XName -> (QName -> XName) -> Maybe QName -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ElementDecl -> XName
    localTypeExp ElementDecl
    ed)
                                                         (Schema -> QName -> XName
    checkXName Schema
    s)
                                                         (NameAndType -> Maybe QName
    theType NameAndType
    n)
                                 , elem_modifier :: Modifier
    elem_modifier = Occurs -> Modifier
    occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
    forall a b. (a -> b) -> a -> b
    $ ElementDecl -> Occurs
    elem_occurs ElementDecl
    ed
                                 , elem_byRef :: Bool
    elem_byRef    = Bool
    False   -- by reference
                                 , elem_locals :: [Decl]
    elem_locals   = []      -- internal Decl
                                 , elem_substs :: Maybe [XName]
    elem_substs   = Maybe [XName]
    forall a. Maybe a
    Nothing -- substitution group
                             --  , elem_substs   = if elem_abstract ed
                             --                    then fmap (map XName) $
                             --                         Map.lookup (N $ theName n)
                             --                                (env_substGrp env)
                             --                    else Nothing
                                 , elem_comment :: Maybe String
    elem_comment  = Annotation -> Maybe String
    comment (Annotation -> Maybe String) -> Annotation -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ ElementDecl -> Annotation
    elem_annotation ElementDecl
    ed
                                 }
            Right QName
    ref -> case QName -> Map QName ElementDecl -> Maybe ElementDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    ref (Environment -> Map QName ElementDecl
    env_element Environment
    env) of
                           Just ElementDecl
    e' -> (ElementDecl -> Element
    elementDecl ElementDecl
    e')
                                          { elem_modifier =
                                                  occursToModifier (elem_occurs ed)
                                          , elem_byRef = True }
                           Maybe ElementDecl
    Nothing -> -- possible ref is imported qualified?
                               case QName -> Map QName ElementDecl -> Maybe ElementDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ QName -> String
    localName QName
    ref)
                                               (Environment -> Map QName ElementDecl
    env_element Environment
    env) of
                                   Just ElementDecl
    e' -> (ElementDecl -> Element
    elementDecl ElementDecl
    e')
                                                { elem_modifier =
                                                   occursToModifier (elem_occurs ed)
                                                , elem_byRef = True }
                                   Maybe ElementDecl
    Nothing -> XName
    -> XName
    -> Modifier
    -> Bool
    -> [Decl]
    -> Maybe [XName]
    -> Maybe String
    -> Element
    Element ({-name-}QName -> XName
    XName QName
    ref)
                                                  -- best guess at type
                                                  ({-type-}QName -> XName
    XName QName
    ref)
                                                  (Occurs -> Modifier
    occursToModifier (ElementDecl -> Occurs
    elem_occurs ElementDecl
    ed))
                                                  Bool
    True [] Maybe [XName]
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing

        localTypeExp :: XSD.ElementDecl -> XName
        localTypeExp :: ElementDecl -> XName
    localTypeExp ElementDecl
    ed | Maybe (Either SimpleType ComplexType) -> Bool
    forall a. Maybe a -> Bool
    isJust (ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    ed) =
                              case Maybe (Either SimpleType ComplexType)
    -> Either SimpleType ComplexType
    forall a. HasCallStack => Maybe a -> a
    fromJust (ElementDecl -> Maybe (Either SimpleType ComplexType)
    elem_content ElementDecl
    ed) of
                                Left st :: SimpleType
    st@Primitive{}   -> String -> XName
    xname String
    "SomethingPrimitive"
                                Left st :: SimpleType
    st@Restricted{}  -> (\XName
    x-> XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe XName
    x String -> XName
    xname
                                                              (SimpleType -> Maybe String
    simple_name SimpleType
    st)) (XName -> XName) -> XName -> XName
    forall a b. (a -> b) -> a -> b
    $
                                                         XName -> (QName -> XName) -> Maybe QName -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    xname String
    "GiveUp")
                                                               QName -> XName
    XName
                                                          (Restriction -> Maybe QName
    restrict_base (Restriction -> Maybe QName) -> Restriction -> Maybe QName
    forall a b. (a -> b) -> a -> b
    $
                                                           SimpleType -> Restriction
    simple_restriction SimpleType
    st)
                                Left st :: SimpleType
    st@ListOf{}      -> String -> XName
    xname String
    "SomethingListy"
                                Left st :: SimpleType
    st@UnionOf{}     -> String -> XName
    xname String
    "SomethingUnionLike"
                                Right c :: ComplexType
    c@ComplexType{} -> XName -> (String -> XName) -> Maybe String -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ElementDecl -> XName
    localTypeExp ElementDecl
    ed{elem_content=Nothing})
                                                               String -> XName
    xname
                                                         (Maybe String -> XName) -> Maybe String -> XName
    forall a b. (a -> b) -> a -> b
    $ ComplexType -> Maybe String
    complex_name ComplexType
    c
                        | Bool
    otherwise =
                              case ElementDecl -> Either NameAndType QName
    elem_nameOrRef ElementDecl
    ed of
                                Left NameAndType
    n  -> String -> XName
    xname (String -> XName) -> String -> XName
    forall a b. (a -> b) -> a -> b
    $ NameAndType -> String
    theName NameAndType
    n
                                Right QName
    _ -> String -> XName
    xname String
    "unknownElement"

        attributeDecl :: XSD.AttributeDecl -> [Haskell.Attribute]
        attributeDecl :: AttributeDecl -> [Attribute]
    attributeDecl AttributeDecl
    ad = case AttributeDecl -> Either NameAndType QName
    attr_nameOrRef AttributeDecl
    ad of
            Left  NameAndType
    n   -> Attribute -> [Attribute]
    forall a. a -> [a]
    singleton (Attribute -> [Attribute]) -> Attribute -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $
                         XName -> XName -> Bool -> Maybe String -> Attribute
    Attribute (String -> XName
    xname (String -> XName) -> String -> XName
    forall a b. (a -> b) -> a -> b
    $ NameAndType -> String
    theName NameAndType
    n)
                                   (XName -> (QName -> XName) -> Maybe QName -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (XName -> (SimpleType -> XName) -> Maybe SimpleType -> XName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> XName
    xname String
    "String")
                                               -- guess at an attribute typename?
                                               --(error "XSD.attributeDecl->")
                                                 SimpleType -> XName
    nameOfSimple
                                                 (AttributeDecl -> Maybe SimpleType
    attr_simpleType AttributeDecl
    ad))
                                          QName -> XName
    XName
                                          (NameAndType -> Maybe QName
    theType NameAndType
    n))
                                   (AttributeDecl -> Use
    attr_use AttributeDecl
    ad Use -> Use -> Bool
    forall a. Eq a => a -> a -> Bool
    == Use
    Required)
                                   (Annotation -> Maybe String
    comment  (AttributeDecl -> Annotation
    attr_annotation AttributeDecl
    ad))
            Right QName
    ref -> case QName -> Map QName AttributeDecl -> Maybe AttributeDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    ref (Environment -> Map QName AttributeDecl
    env_attribute Environment
    env) of
                           Maybe AttributeDecl
    Nothing -> String -> [Attribute]
    forall a. HasCallStack => String -> a
    error (String -> [Attribute]) -> String -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $ String
    "<attributeDecl> unknown attribute reference "
                                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    printableName QName
    ref
                           Just AttributeDecl
    a' -> AttributeDecl -> [Attribute]
    attributeDecl AttributeDecl
    a'

        attrgroup :: XSD.AttrGroup -> [Haskell.Attribute]
        attrgroup :: AttrGroup -> [Attribute]
    attrgroup AttrGroup
    g = case AttrGroup -> Either String QName
    attrgroup_nameOrRef AttrGroup
    g of
            Left  String
    n   -> (Either AttributeDecl AttrGroup -> [Attribute])
    -> [Either AttributeDecl AttrGroup] -> [Attribute]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((AttributeDecl -> [Attribute])
    -> (AttrGroup -> [Attribute])
    -> Either AttributeDecl AttrGroup
    -> [Attribute]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either AttributeDecl -> [Attribute]
    attributeDecl AttrGroup -> [Attribute]
    attrgroup)
                                   (AttrGroup -> [Either AttributeDecl AttrGroup]
    attrgroup_stuff AttrGroup
    g)
            Right QName
    ref -> case QName -> Map QName AttrGroup -> Maybe AttrGroup
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    ref (Environment -> Map QName AttrGroup
    env_attrgroup Environment
    env) of
                           Maybe AttrGroup
    Nothing -> String -> [Attribute]
    forall a. HasCallStack => String -> a
    error (String -> [Attribute]) -> String -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $ String
    "unknown attribute group reference "
                                              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    printableName QName
    ref
                           Just AttrGroup
    g' -> AttrGroup -> [Attribute]
    attrgroup AttrGroup
    g'

        group :: XSD.Group -> [Haskell.Decl]
        group :: Group -> [Decl]
    group Group
    g = case Group -> Either String QName
    group_nameOrRef Group
    g of
            Left  String
    n   -> let {-highs,-}es :: [Element]
    es = ChoiceOrSeq -> [Element]
    choiceOrSeq (ChoiceOrSeq -> Maybe ChoiceOrSeq -> ChoiceOrSeq
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ChoiceOrSeq
    forall a. HasCallStack => String -> a
    error String
    "XSD.group")
                                                                 (Group -> Maybe ChoiceOrSeq
    group_stuff Group
    g))
                         in {-highs ++-} Decl -> [Decl]
    forall a. a -> [a]
    singleton (Decl -> [Decl]) -> Decl -> [Decl]
    forall a b. (a -> b) -> a -> b
    $
                               XName -> [Element] -> Maybe String -> Decl
    Haskell.Group (String -> XName
    xname String
    n)
                                             ((Element -> Element) -> [Element] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Element
    e->Element
    e{elem_modifier=
                                                             combineOccursModifier
                                                                 (group_occurs g)
                                                                 (elem_modifier e)})
                                                  [Element]
    es)
                                             (Annotation -> Maybe String
    comment (Group -> Annotation
    group_annotation Group
    g))
            Right (QN Namespace
    _ String
    ref) -> case QName -> Map QName Group -> Maybe Group
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (String -> QName
    N String
    ref) (Environment -> Map QName Group
    env_group Environment
    env) of
                           Maybe Group
    Nothing -> String -> [Decl]
    forall a. HasCallStack => String -> a
    error (String -> [Decl]) -> String -> [Decl]
    forall a b. (a -> b) -> a -> b
    $ String
    "bad group reference "
                                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    printableName (String -> QName
    N String
    ref)
                           Just Group
    g' -> Group -> [Decl]
    group Group
    g'{ group_occurs=group_occurs g }
            Right QName
    ref -> case QName -> Map QName Group -> Maybe Group
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    ref (Environment -> Map QName Group
    env_group Environment
    env) of
                      --   Nothing -> error $ "bad group reference "
                      --                      ++printableName ref
                           Maybe Group
    Nothing -> Decl -> [Decl]
    forall a. a -> [a]
    singleton (Decl -> [Decl]) -> Decl -> [Decl]
    forall a b. (a -> b) -> a -> b
    $
                                      XName -> [Element] -> Maybe String -> Decl
    Haskell.Group (String -> XName
    xname (String
    "unknown-group-"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++QName -> String
    printableName QName
    ref)) []
                                                    (Annotation -> Maybe String
    comment (Group -> Annotation
    group_annotation Group
    g))
                           Just Group
    g' -> Group -> [Decl]
    group Group
    g'{ group_occurs=group_occurs g }

        particleAttrs :: ParticleAttrs -> ([Haskell.Element],[Haskell.Attribute])
        particleAttrs :: ParticleAttrs -> ([Element], [Attribute])
    particleAttrs (PA Particle
    part [Either AttributeDecl AttrGroup]
    attrs Maybe AnyAttr
    _) = -- ignoring AnyAttr for now
            (Particle -> [Element]
    particle Particle
    part, (Either AttributeDecl AttrGroup -> [Attribute])
    -> [Either AttributeDecl AttrGroup] -> [Attribute]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((AttributeDecl -> [Attribute])
    -> (AttrGroup -> [Attribute])
    -> Either AttributeDecl AttrGroup
    -> [Attribute]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either AttributeDecl -> [Attribute]
    attributeDecl AttrGroup -> [Attribute]
    attrgroup) [Either AttributeDecl AttrGroup]
    attrs)

        particle :: Particle -> [Haskell.Element] -- XXX fix to ret Decls
        particle :: Particle -> [Element]
    particle Particle
    Nothing          = []
        particle (Just (Left ChoiceOrSeq
    cs)) = {-snd $-} ChoiceOrSeq -> [Element]
    choiceOrSeq ChoiceOrSeq
    cs
        particle (Just (Right Group
    g)) = let [Haskell.Group XName
    _ [Element]
    es Maybe String
    _] = Group -> [Decl]
    group Group
    g in [Element]
    es

    --  choiceOrSeq :: ChoiceOrSeq -> ([Haskell.Decl],[Haskell.Element])
        choiceOrSeq :: ChoiceOrSeq -> [Haskell.Element]
        choiceOrSeq :: ChoiceOrSeq -> [Element]
    choiceOrSeq (XSD.All      Annotation
    ann [ElementDecl]
    eds)   = String -> [Element]
    forall a. HasCallStack => String -> a
    error String
    "not yet implemented: XSD.All"
        choiceOrSeq (XSD.Choice   Annotation
    ann Occurs
    o [ElementEtc]
    ees) = [ [[Element]] -> Modifier -> Maybe String -> Element
    OneOf ([[Element]] -> [[Element]]
    anyToEnd
                                                         ((ElementEtc -> [Element]) -> [ElementEtc] -> [[Element]]
    forall a b. (a -> b) -> [a] -> [b]
    map ElementEtc -> [Element]
    elementEtc [ElementEtc]
    ees))
                                                       (Occurs -> Modifier
    occursToModifier Occurs
    o)
                                                       (Annotation -> Maybe String
    comment Annotation
    ann) ]
        choiceOrSeq (XSD.Sequence Annotation
    ann Occurs
    _ [ElementEtc]
    ees) = (ElementEtc -> [Element]) -> [ElementEtc] -> [Element]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ElementEtc -> [Element]
    elementEtc [ElementEtc]
    ees

        elementEtc :: ElementEtc -> [Haskell.Element]
        elementEtc :: ElementEtc -> [Element]
    elementEtc (HasElement ElementDecl
    ed) = [ElementDecl -> Element
    elementDecl ElementDecl
    ed]
        elementEtc (HasGroup Group
    g)    = let [Haskell.Group XName
    _ [Element]
    es Maybe String
    _] = Group -> [Decl]
    group Group
    g in [Element]
    es
        elementEtc (HasCS ChoiceOrSeq
    cs)      = ChoiceOrSeq -> [Element]
    choiceOrSeq ChoiceOrSeq
    cs
        elementEtc (HasAny Any
    a)      = Any -> [Element]
    any Any
    a

        any :: XSD.Any -> [Haskell.Element]
        any :: Any -> [Element]
    any a :: Any
    a@XSD.Any{}  = [Haskell.AnyElem
                               { elem_modifier :: Modifier
    elem_modifier = Occurs -> Modifier
    occursToModifier (Any -> Occurs
    any_occurs Any
    a)
                               , elem_comment :: Maybe String
    elem_comment  = Annotation -> Maybe String
    comment (Any -> Annotation
    any_annotation Any
    a) }]

        -- If an ANY element is part of a choice, ensure it is the last part.
        anyToEnd :: [[Haskell.Element]] -> [[Haskell.Element]]
        anyToEnd :: [[Element]] -> [[Element]]
    anyToEnd = Maybe [Element] -> [[Element]] -> [[Element]]
    go Maybe [Element]
    forall a. Maybe a
    Nothing
          where go :: Maybe [Element] -> [[Element]] -> [[Element]]
    go Maybe [Element]
    _ [e :: [Element]
    e@[AnyElem{}]] = [[Element]
    e]
                go Maybe [Element]
    _ (e :: [Element]
    e@[AnyElem{}]:[[Element]]
    es) = Maybe [Element] -> [[Element]] -> [[Element]]
    go ([Element] -> Maybe [Element]
    forall a. a -> Maybe a
    Just [Element]
    e) [[Element]]
    es
                go Maybe [Element]
    Nothing  []        = []
                go (Just [Element]
    e) []        = [[Element]
    e]
                go Maybe [Element]
    m ([Element]
    e:[[Element]]
    es)           = [Element]
    e[Element] -> [[Element]] -> [[Element]]
    forall a. a -> [a] -> [a]
    :Maybe [Element] -> [[Element]] -> [[Element]]
    go Maybe [Element]
    m [[Element]]
    es

        contentInfo :: Maybe (Either SimpleType ComplexType)
                       -> ([Haskell.Element],[Haskell.Attribute])
        contentInfo :: Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
    contentInfo Maybe (Either SimpleType ComplexType)
    Nothing  = ([],[])
        contentInfo (Just Either SimpleType ComplexType
    e) = (SimpleType -> ([Element], [Attribute]))
    -> (ComplexType -> ([Element], [Attribute]))
    -> Either SimpleType ComplexType
    -> ([Element], [Attribute])
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SimpleType -> ([Element], [Attribute])
    simple ComplexType -> ([Element], [Attribute])
    complex Either SimpleType ComplexType
    e
          where
            simple  :: SimpleType  -> ([Element],[Attribute])
            complex :: ComplexType -> ([Element],[Attribute])
            simple :: SimpleType -> ([Element], [Attribute])
    simple SimpleType
    _         = ([], [])  -- XXX clearly wrong
         -- simple (Primitive p)        = ([], [])  -- XXX clearly wrong
         -- simple (Restricted n _ _ _) =
            complex :: ComplexType -> ([Element], [Attribute])
    complex ComplexType
    ct = case ComplexType -> ComplexItem
    complex_content ComplexType
    ct of
                           SimpleContent{}     -> ([],[]) -- XXX clearly wrong
                           ci :: ComplexItem
    ci@ComplexContent{} -> (Restriction1 -> ([Element], [Attribute]))
    -> (Extension -> ([Element], [Attribute]))
    -> Either Restriction1 Extension
    -> ([Element], [Attribute])
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Restriction1 -> ([Element], [Attribute])
    restr Extension -> ([Element], [Attribute])
    exten (ComplexItem -> Either Restriction1 Extension
    ci_stuff ComplexItem
    ci)
                           ThisType ParticleAttrs
    pa         -> ParticleAttrs -> ([Element], [Attribute])
    particleAttrs ParticleAttrs
    pa
            restr :: Restriction1 -> ([Element],[Attribute])
            exten :: Extension    -> ([Element],[Attribute])
            restr :: Restriction1 -> ([Element], [Attribute])
    restr (Restriction1 Particle
    p)  = (Particle -> [Element]
    particle Particle
    p,[])
            exten :: Extension -> ([Element], [Attribute])
    exten Extension
    e = let ([Element]
    oes,[Attribute]
    oas) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
    contentInfo (QName
    -> Map QName (Either SimpleType ComplexType)
    -> Maybe (Either SimpleType ComplexType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (Extension -> QName
    extension_base Extension
    e)
                                                              (Environment -> Map QName (Either SimpleType ComplexType)
    env_type Environment
    env))
                          ([Element]
    nes,[Attribute]
    nas) = ParticleAttrs -> ([Element], [Attribute])
    particleAttrs (Extension -> ParticleAttrs
    extension_newstuff Extension
    e)
                      in ([Element]
    oes[Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++[Element]
    nes, [Attribute]
    oas[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    nas)

    comment :: Annotation -> Comment
    comment :: Annotation -> Maybe String
    comment (Documentation String
    s) = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s
    comment (AppInfo String
    s)       = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s
    comment (NoAnnotation String
    _)  = Maybe String
    forall a. Maybe a
    Nothing

    xname :: String -> XName
    xname :: String -> XName
    xname = QName -> XName
    XName (QName -> XName) -> (String -> QName) -> String -> XName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> QName
    N

    checkXName :: Schema -> QName -> XName
    checkXName :: Schema -> QName -> XName
    checkXName Schema
    s n :: QName
    n@(N String
    _)     = QName -> XName
    XName QName
    n
    checkXName Schema
    s n :: QName
    n@(QN Namespace
    ns String
    m) | (Just String
    uri) <- Schema -> Maybe String
    schema_targetNamespace Schema
    s
                             , Namespace -> String
    nsURI Namespace
    ns String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    uri = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N String
    m
                             | Bool
    otherwise       = QName -> XName
    XName QName
    n

    nameOfSimple :: SimpleType -> XName
    nameOfSimple :: SimpleType -> XName
    nameOfSimple (Primitive PrimitiveType
    prim)            = QName -> XName
    XName (QName -> XName)
    -> (PrimitiveType -> QName) -> PrimitiveType -> XName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> QName
    xsd (String -> QName)
    -> (PrimitiveType -> String) -> PrimitiveType -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrimitiveType -> String
    forall a. Show a => a -> String
    show (PrimitiveType -> XName) -> PrimitiveType -> XName
    forall a b. (a -> b) -> a -> b
    $ PrimitiveType
    prim
    nameOfSimple (Restricted Annotation
    _ (Just String
    n) Maybe Final
    _ Restriction
    _) = String -> XName
    xname String
    n
    nameOfSimple (ListOf Annotation
    _ (Just String
    n) Maybe Final
    _ Either SimpleType QName
    _)     = String -> XName
    xname String
    n -- ("["++n++"]")
    nameOfSimple (UnionOf Annotation
    _ (Just String
    n) Maybe Final
    _ [SimpleType]
    _ [QName]
    _)  = String -> XName
    xname String
    n -- return to this
    nameOfSimple SimpleType
    s                           = String -> XName
    xname String
    "String" -- anonymous simple

    mkRestrict :: XSD.Restriction -> [Haskell.Restrict]
    mkRestrict :: Restriction -> [Restrict]
    mkRestrict (RestrictSim1 Annotation
    ann Maybe QName
    base Restriction1
    r1) = []
    --      = error "Not yet implemented: Restriction1 on simpletype"
    --      ^ This branch is not strictly correct.  There ought to be some
    --        restrictions.
    mkRestrict (RestrictType Annotation
    _ Maybe QName
    _ Maybe SimpleType
    _ [Facet]
    facets) =
        (let occurs :: [(FacetType, Annotation, String)]
    occurs = [ (FacetType
    f,Annotation
    ann,String
    v)  | (Facet FacetType
    f Annotation
    ann String
    v Bool
    _) <- [Facet]
    facets
                                   , FacetType
    f FacetType -> [FacetType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [FacetType
    OrderedBoundsMinIncl
                                              ,FacetType
    OrderedBoundsMinExcl
                                              ,FacetType
    OrderedBoundsMaxIncl
                                              ,FacetType
    OrderedBoundsMaxExcl] ]
         in [Occurs -> Maybe String -> Restrict
    Haskell.RangeR ((Occurs -> (FacetType, Annotation, String) -> Occurs)
    -> Occurs -> [(FacetType, Annotation, String)] -> Occurs
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Occurs -> (FacetType, Annotation, String) -> Occurs
    consolidate (Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    forall a. Maybe a
    Nothing Maybe Int
    forall a. Maybe a
    Nothing) [(FacetType, Annotation, String)]
    occurs)
              (Annotation -> Maybe String
    comment (Annotation -> Maybe String) -> Annotation -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [Annotation] -> Annotation
    forall a. Monoid a => [a] -> a
    mconcat [ Annotation
    ann | (FacetType
    _,Annotation
    ann,String
    _) <- [(FacetType, Annotation, String)]
    occurs]) | [(FacetType, Annotation, String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FacetType, Annotation, String)]
    occurs]
        ) [Restrict] -> [Restrict] -> [Restrict]
    forall a. [a] -> [a] -> [a]
    ++
        [ String -> Maybe String -> Restrict
    Haskell.Pattern String
    v (Annotation -> Maybe String
    comment Annotation
    ann)
                  | (Facet FacetType
    UnorderedPattern Annotation
    ann String
    v Bool
    _) <- [Facet]
    facets ]
        [Restrict] -> [Restrict] -> [Restrict]
    forall a. [a] -> [a] -> [a]
    ++
        (let enum :: [(String, Maybe String)]
    enum = [ (String
    v,Annotation -> Maybe String
    comment Annotation
    ann)
                    | (Facet FacetType
    UnorderedEnumeration Annotation
    ann String
    v Bool
    _) <- [Facet]
    facets ]
         in [[(String, Maybe String)] -> Restrict
    Haskell.Enumeration [(String, Maybe String)]
    enum | [(String, Maybe String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(String, Maybe String)]
    enum]
        ) [Restrict] -> [Restrict] -> [Restrict]
    forall a. [a] -> [a] -> [a]
    ++
        (let occurs :: [(FacetType, Annotation, String)]
    occurs = [ (FacetType
    f,Annotation
    ann,String
    v)  | (Facet FacetType
    f Annotation
    ann String
    v Bool
    _) <- [Facet]
    facets
                                   , FacetType
    f FacetType -> [FacetType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [FacetType
    UnorderedLength
                                              ,FacetType
    UnorderedMaxLength
                                              ,FacetType
    UnorderedMinLength] ]
         in [Occurs -> Maybe String -> Restrict
    Haskell.StrLength
              ((Occurs -> (FacetType, Annotation, String) -> Occurs)
    -> Occurs -> [(FacetType, Annotation, String)] -> Occurs
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Occurs -> (FacetType, Annotation, String) -> Occurs
    consolidate (Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    forall a. Maybe a
    Nothing Maybe Int
    forall a. Maybe a
    Nothing) [(FacetType, Annotation, String)]
    occurs)
              (Annotation -> Maybe String
    comment (Annotation -> Maybe String) -> Annotation -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [Annotation] -> Annotation
    forall a. Monoid a => [a] -> a
    mconcat [ Annotation
    ann | (FacetType
    _,Annotation
    ann,String
    _) <- [(FacetType, Annotation, String)]
    occurs]) | [(FacetType, Annotation, String)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FacetType, Annotation, String)]
    occurs]
        )

    singleton :: a -> [a]
    singleton :: forall a. a -> [a]
    singleton = (a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[])

    -- | Consolidate a Facet occurrence into a single Occurs value.
    consolidate :: Occurs -> (FacetType,Annotation,String) -> Occurs
    consolidate :: Occurs -> (FacetType, Annotation, String) -> Occurs
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    OrderedBoundsMinIncl,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n)) Maybe Int
    max
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    OrderedBoundsMinExcl,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)) Maybe Int
    max
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    OrderedBoundsMaxIncl,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    min (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n))
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    OrderedBoundsMaxExcl,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    min (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    UnorderedLength,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n)) (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n))
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    UnorderedMinLength,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n)) Maybe Int
    max
    consolidate (Occurs Maybe Int
    min Maybe Int
    max) (FacetType
    UnorderedMaxLength,Annotation
    _,String
    n) =
                 Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    min (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (String -> Int
    forall a. Read a => String -> a
    read String
    n))

    instance Monoid Occurs where
        mempty :: Occurs
    mempty = Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    forall a. Maybe a
    Nothing Maybe Int
    forall a. Maybe a
    Nothing
        mappend :: Occurs -> Occurs -> Occurs
    mappend = Occurs -> Occurs -> Occurs
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance Semigroup Occurs where
        (Occurs Maybe Int
    Nothing  Maybe Int
    Nothing)  <> :: Occurs -> Occurs -> Occurs
    <> Occurs
    o  = Occurs
    o
        (Occurs (Just Int
    z) Maybe Int
    Nothing)  <> (Occurs Maybe Int
    min Maybe Int
    max)
                                            = Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    z (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    z) Maybe Int
    min) Maybe Int
    max
        (Occurs Maybe Int
    Nothing  (Just Int
    x)) <> (Occurs Maybe Int
    min Maybe Int
    max)
                                            = Maybe Int -> Maybe Int -> Occurs
    Occurs Maybe Int
    min (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    x (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    x) Maybe Int
    max)
        (Occurs (Just Int
    z) (Just Int
    x)) <> (Occurs Maybe Int
    min Maybe Int
    max)
                                            = Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    z (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    z) Maybe Int
    min)
                                                     (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    x (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    x) Maybe Int
    max)

    -- | Push another Occurs value inside an existing Modifier.
    combineOccursModifier :: Occurs -> Modifier -> Modifier
    combineOccursModifier :: Occurs -> Modifier -> Modifier
    combineOccursModifier Occurs
    o Modifier
    Haskell.Single     = Occurs -> Modifier
    occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
    forall a b. (a -> b) -> a -> b
    $ Occurs -> Occurs -> Occurs
    forall a. Monoid a => a -> a -> a
    mappend Occurs
    o
                                                        (Occurs -> Occurs) -> Occurs -> Occurs
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    1) (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    1)
    combineOccursModifier Occurs
    o Modifier
    Haskell.Optional   = Occurs -> Modifier
    occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
    forall a b. (a -> b) -> a -> b
    $ Occurs -> Occurs -> Occurs
    forall a. Monoid a => a -> a -> a
    mappend Occurs
    o
                                                        (Occurs -> Occurs) -> Occurs -> Occurs
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Maybe Int -> Occurs
    Occurs (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    0) (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    1)
    combineOccursModifier Occurs
    o (Haskell.Range Occurs
    o') = Occurs -> Modifier
    occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
    forall a b. (a -> b) -> a -> b
    $ Occurs -> Occurs -> Occurs
    forall a. Monoid a => a -> a -> a
    mappend Occurs
    o Occurs
    o'

    -- | Convert an occurs range to a Haskell-style type modifier (Maybe, List, Id)
    occursToModifier :: Occurs -> Modifier
    occursToModifier :: Occurs -> Modifier
    occursToModifier (Occurs Maybe Int
    Nothing  Maybe Int
    Nothing)  = Modifier
    Haskell.Single
    occursToModifier (Occurs (Just Int
    0) Maybe Int
    Nothing)  = Modifier
    Haskell.Optional
    occursToModifier (Occurs (Just Int
    0) (Just Int
    1)) = Modifier
    Haskell.Optional
    occursToModifier (Occurs (Just Int
    1) (Just Int
    1)) = Modifier
    Haskell.Single
    occursToModifier Occurs
    o                          = Occurs -> Modifier
    Haskell.Range Occurs
    o

    -- | Find the supertype (if it exists) of a given type name.
    supertypeOf :: Environment -> QName -> Maybe QName
    supertypeOf :: Environment -> QName -> Maybe QName
    supertypeOf Environment
    env QName
    t =
        do typ <- QName
    -> Map QName (Either SimpleType ComplexType)
    -> Maybe (Either SimpleType ComplexType)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup QName
    t (Environment -> Map QName (Either SimpleType ComplexType)
    env_type Environment
    env)
           a <- either (const Nothing) (Just . complex_content) typ
           b <- case a of ComplexContent{} -> Either Restriction1 Extension
    -> Maybe (Either Restriction1 Extension)
    forall a. a -> Maybe a
    Just (ComplexItem -> Either Restriction1 Extension
    ci_stuff ComplexItem
    a)
                          ComplexItem
    _ -> Maybe (Either Restriction1 Extension)
    forall a. Maybe a
    Nothing
           either (const Nothing) (Just . extension_base) b

    -- | Keep applying the function to transform the value, until it yields
    --   Nothing.  Returns the sequence of transformed values.
    repeatedly :: (a->Maybe a) -> a -> [a]
    repeatedly :: forall a. (a -> Maybe a) -> a -> [a]
    repeatedly a -> Maybe a
    f a
    x = case a -> Maybe a
    f a
    x of Maybe a
    Nothing -> []
                                 Just a
    y  -> a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> Maybe a) -> a -> [a]
    forall a. (a -> Maybe a) -> a -> [a]
    repeatedly a -> Maybe a
    f a
    y