    module Text.XML.HaXml.Schema.Parse
      ( module Text.XML.HaXml.Schema.Parse
      ) where

    import Data.Char (isSpace)
    import Data.List (isPrefixOf)
    import Data.Monoid (Monoid(mappend))
    -- import Text.ParserCombinators.Poly
    import Text.Parse    -- for String parsers

    import Text.XML.HaXml.Types      (Name,QName(..),Namespace(..),Attribute(..)
                                     ,Content(..),Element(..),info)
    import Text.XML.HaXml.Namespaces
    import Text.XML.HaXml.Verbatim hiding (qname)
    import Text.XML.HaXml.Posn
    import Text.XML.HaXml.Schema.XSDTypeModel as XSD
    import Text.XML.HaXml.XmlContent.Parser (text)

    -- | Lift boolean 'or' over predicates.
    (|||) :: (a->Bool) -> (a->Bool) -> (a->Bool)
    a -> Bool
    p ||| :: forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
    ||| a -> Bool
    q = \a
    v -> a -> Bool
    p a
    v Bool -> Bool -> Bool
    || a -> Bool
    q a
    v

    -- | Qualify an ordinary name with the XSD namespace.
    xsd :: Name -> QName
    xsd :: TargetNamespace -> QName
    xsd = Namespace -> TargetNamespace -> QName
    QN Namespace{nsPrefix :: TargetNamespace
    nsPrefix=TargetNamespace
    "xsd",nsURI :: TargetNamespace
    nsURI=TargetNamespace
    "http://www.w3.org/2001/XMLSchema"}

    -- | Predicate for comparing against an XSD-qualified name.  (Also accepts
    --   unqualified names, but this is probably a bit too lax.  Doing it right
    --   would require checking to see whether the current schema module's default
    --   namespace is XSD or not.)
    xsdTag :: String -> Content Posn -> Bool
    xsdTag :: TargetNamespace -> Content Posn -> Bool
    xsdTag TargetNamespace
    tag (CElem (Elem QName
    qn [Attribute]
    _ [Content Posn]
    _) Posn
    _)  =  QName
    qn QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == TargetNamespace -> QName
    xsd TargetNamespace
    tag Bool -> Bool -> Bool
    || QName
    qn QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == TargetNamespace -> QName
    N TargetNamespace
    tag
    xsdTag TargetNamespace
    _   Content Posn
    _                        =  Bool
    False

    -- | We need a Parser monad for reading from a sequence of generic XML
    --   Contents into specific datatypes that model the structure of XSD
    --   descriptions.  This is a specialisation of the polyparse combinators,
    --   fixing the input token type.
    type XsdParser a = Parser (Content Posn) a

    -- | Get the next content element, checking that it matches some criterion
    --   given by the predicate.
    --   (Skips over comments and whitespace, rejects text and refs.
    --    Also returns position of element.)
    --   The list of strings argument is for error reporting - it usually
    --   represents a list of expected tags.
    posnElementWith :: (Content Posn->Bool) -> [String]
                       -> XsdParser (Posn,Element Posn)
    posnElementWith :: (Content Posn -> Bool)
    -> [TargetNamespace] -> XsdParser (Posn, Element Posn)
    posnElementWith Content Posn -> Bool
    match [TargetNamespace]
    tags = do
        { c <- Parser (Content Posn) (Content Posn)
    forall t. Parser t t
    next Parser (Content Posn) (Content Posn)
    -> (TargetNamespace -> TargetNamespace)
    -> Parser (Content Posn) (Content Posn)
    forall a.
    Parser (Content Posn) a
    -> (TargetNamespace -> TargetNamespace) -> Parser (Content Posn) a
    forall (p :: * -> *) a.
    Commitment p =>
    p a -> (TargetNamespace -> TargetNamespace) -> p a
    `adjustErr` (TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    " when expecting "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++[TargetNamespace] -> TargetNamespace
    formatted [TargetNamespace]
    tags)
        ; case c of
            CElem Element Posn
    e Posn
    pos
                | Content Posn -> Bool
    match Content Posn
    c   -> (Posn, Element Posn) -> XsdParser (Posn, Element Posn)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Posn
    pos,Element Posn
    e)
            CElem (Elem QName
    t [Attribute]
    _ [Content Posn]
    _) Posn
    pos
                | Bool
    otherwise -> TargetNamespace -> XsdParser (Posn, Element Posn)
    forall a. TargetNamespace -> Parser (Content Posn) a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail (TargetNamespace
    "Found a <"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    t
                                     TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    ">, but expected "
                                     TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++[TargetNamespace] -> TargetNamespace
    formatted [TargetNamespace]
    tagsTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\nat "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++Posn -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show Posn
    pos)
            CString Bool
    b TargetNamespace
    s Posn
    pos  -- ignore blank space
                | Bool -> Bool
    not Bool
    b Bool -> Bool -> Bool
    && (Char -> Bool) -> TargetNamespace -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace TargetNamespace
    s -> (Content Posn -> Bool)
    -> [TargetNamespace] -> XsdParser (Posn, Element Posn)
    posnElementWith Content Posn -> Bool
    match [TargetNamespace]
    tags
                | Bool
    otherwise -> TargetNamespace -> XsdParser (Posn, Element Posn)
    forall a. TargetNamespace -> Parser (Content Posn) a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail (TargetNamespace
    "Found text content, but expected "
                                     TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++[TargetNamespace] -> TargetNamespace
    formatted [TargetNamespace]
    tagsTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\ntext is: "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    s
                                     TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\nat "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++Posn -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show Posn
    pos)
            CRef Reference
    r Posn
    pos -> TargetNamespace -> XsdParser (Posn, Element Posn)
    forall a. TargetNamespace -> Parser (Content Posn) a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail (TargetNamespace
    "Found reference, but expected "
                                TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++[TargetNamespace] -> TargetNamespace
    formatted [TargetNamespace]
    tagsTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\nreference is: "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++Reference -> TargetNamespace
    forall a. Verbatim a => a -> TargetNamespace
    verbatim Reference
    r
                                TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\nat "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++Posn -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show Posn
    pos)
            CMisc Misc
    _ Posn
    _ -> (Content Posn -> Bool)
    -> [TargetNamespace] -> XsdParser (Posn, Element Posn)
    posnElementWith Content Posn -> Bool
    match [TargetNamespace]
    tags  -- skip comments, PIs, etc.
        }
      where
        formatted :: [TargetNamespace] -> TargetNamespace
    formatted [TargetNamespace
    t]  = TargetNamespace
    "a <"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    tTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    ">"
        formatted [TargetNamespace]
    tgs = TargetNamespace
    "one of"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++ (TargetNamespace -> TargetNamespace)
    -> [TargetNamespace] -> TargetNamespace
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\TargetNamespace
    t->TargetNamespace
    " <"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    tTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    ">") [TargetNamespace]
    tgs

    -- | Get the next content element, checking that it has the required tag
    --   belonging to the XSD namespace.
    xsdElement :: Name -> XsdParser (Element Posn)
    xsdElement :: TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    n = ((Posn, Element Posn) -> Element Posn)
    -> XsdParser (Posn, Element Posn) -> XsdParser (Element Posn)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Posn, Element Posn) -> Element Posn
    forall a b. (a, b) -> b
    snd ((Content Posn -> Bool)
    -> [TargetNamespace] -> XsdParser (Posn, Element Posn)
    posnElementWith (TargetNamespace -> Content Posn -> Bool
    xsdTag TargetNamespace
    n) [TargetNamespace
    "xsd:"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    n])

    -- | Get the next content element, whatever it is.
    anyElement :: XsdParser (Element Posn)
    anyElement :: XsdParser (Element Posn)
    anyElement = ((Posn, Element Posn) -> Element Posn)
    -> XsdParser (Posn, Element Posn) -> XsdParser (Element Posn)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Posn, Element Posn) -> Element Posn
    forall a b. (a, b) -> b
    snd ((Content Posn -> Bool)
    -> [TargetNamespace] -> XsdParser (Posn, Element Posn)
    posnElementWith (Bool -> Content Posn -> Bool
    forall a b. a -> b -> a
    const Bool
    True) [TargetNamespace
    "any element"])

    -- | Grab and parse any and all children of the next element.
    allChildren :: XsdParser a -> XsdParser a
    allChildren :: forall a. XsdParser a -> XsdParser a
    allChildren XsdParser a
    p = do e <- XsdParser (Element Posn)
    anyElement
                       interiorWith (const True) p e

    -- | Run an XsdParser on the child contents of the given element (i.e. not
    --   in the current monadic content sequence), filtering the children
    --   before parsing, and checking that the contents are exhausted, before
    --   returning the calculated value within the current parser context.
    interiorWith :: (Content Posn->Bool) -> XsdParser a
                    -> Element Posn -> XsdParser a
    interiorWith :: forall a.
    (Content Posn -> Bool)
    -> XsdParser a -> Element Posn -> XsdParser a
    interiorWith Content Posn -> Bool
    keep (P [Content Posn] -> Result [Content Posn] a
    p) (Elem QName
    e [Attribute]
    _ [Content Posn]
    cs) = ([Content Posn] -> Result [Content Posn] a)
    -> Parser (Content Posn) a
    forall t a. ([t] -> Result [t] a) -> Parser t a
    P (([Content Posn] -> Result [Content Posn] a)
     -> Parser (Content Posn) a)
    -> ([Content Posn] -> Result [Content Posn] a)
    -> Parser (Content Posn) a
    forall a b. (a -> b) -> a -> b
    $ \[Content Posn]
    inp->
        [Content Posn]
    -> Result [Content Posn] a -> Result [Content Posn] a
    forall t x a. t -> Result x a -> Result t a
    tidy [Content Posn]
    inp (Result [Content Posn] a -> Result [Content Posn] a)
    -> Result [Content Posn] a -> Result [Content Posn] a
    forall a b. (a -> b) -> a -> b
    $
        case [Content Posn] -> Result [Content Posn] a
    p ((Content Posn -> Bool) -> [Content Posn] -> [Content Posn]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Content Posn -> Bool
    keep [Content Posn]
    cs) of
            Committed Result [Content Posn] a
    r        -> Result [Content Posn] a
    r
            f :: Result [Content Posn] a
    f@(Failure [Content Posn]
    _ TargetNamespace
    _)    -> Result [Content Posn] a
    f
            s :: Result [Content Posn] a
    s@(Success [] a
    _)   -> Result [Content Posn] a
    s
            Success ds :: [Content Posn]
    ds@(Content Posn
    d:[Content Posn]
    _) a
    a
                | (Content Posn -> Bool) -> [Content Posn] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Content Posn -> Bool
    forall {i}. Content i -> Bool
    onlyMisc [Content Posn]
    ds -> [Content Posn] -> a -> Result [Content Posn] a
    forall z a. z -> a -> Result z a
    Success [] a
    a
                | Bool
    otherwise       -> Result [Content Posn] a -> Result [Content Posn] a
    forall z a. Result z a -> Result z a
    Committed (Result [Content Posn] a -> Result [Content Posn] a)
    -> Result [Content Posn] a -> Result [Content Posn] a
    forall a b. (a -> b) -> a -> b
    $
                                     [Content Posn] -> TargetNamespace -> Result [Content Posn] a
    forall z a. z -> TargetNamespace -> Result z a
    Failure [Content Posn]
    ds (TargetNamespace
    "Too many elements inside <"
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    eTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "> at\n"
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++Posn -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show (Content Posn -> Posn
    forall t. Content t -> t
    info Content Posn
    d)TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\n\n"
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "Found excess: "
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++[Content Posn] -> TargetNamespace
    forall a. Verbatim a => a -> TargetNamespace
    verbatim (Int -> [Content Posn] -> [Content Posn]
    forall a. Int -> [a] -> [a]
    take Int
    5 [Content Posn]
    ds))
      where onlyMisc :: Content i -> Bool
    onlyMisc (CMisc Misc
    _ i
    _) = Bool
    True
            onlyMisc (CString Bool
    False TargetNamespace
    s i
    _) | (Char -> Bool) -> TargetNamespace -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace TargetNamespace
    s = Bool
    True
            onlyMisc Content i
    _ = Bool
    False

    -- | Check for the presence (and value) of an attribute in the given element.
    --   Absence results in failure.
    attribute :: QName -> TextParser a -> Element Posn -> XsdParser a
    attribute :: forall a. QName -> TextParser a -> Element Posn -> XsdParser a
    attribute QName
    qn (P TargetNamespace -> Result TargetNamespace a
    p) (Elem QName
    n [Attribute]
    as [Content Posn]
    _) = ([Content Posn] -> Result [Content Posn] a)
    -> Parser (Content Posn) a
    forall t a. ([t] -> Result [t] a) -> Parser t a
    P (([Content Posn] -> Result [Content Posn] a)
     -> Parser (Content Posn) a)
    -> ([Content Posn] -> Result [Content Posn] a)
    -> Parser (Content Posn) a
    forall a b. (a -> b) -> a -> b
    $ \[Content Posn]
    inp->
        case QName -> [Attribute] -> Maybe AttValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup QName
    qn [Attribute]
    as of
            Maybe AttValue
    Nothing  -> [Content Posn] -> TargetNamespace -> Result [Content Posn] a
    forall z a. z -> TargetNamespace -> Result z a
    Failure [Content Posn]
    inp (TargetNamespace -> Result [Content Posn] a)
    -> TargetNamespace -> Result [Content Posn] a
    forall a b. (a -> b) -> a -> b
    $ TargetNamespace
    "attribute "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    qn
                                      TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    " not present in <"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    nTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    ">"
            Just AttValue
    atv -> [Content Posn]
    -> Result TargetNamespace a -> Result [Content Posn] a
    forall t x a. t -> Result x a -> Result t a
    tidy [Content Posn]
    inp (Result TargetNamespace a -> Result [Content Posn] a)
    -> Result TargetNamespace a -> Result [Content Posn] a
    forall a b. (a -> b) -> a -> b
    $
                        case TargetNamespace -> Result TargetNamespace a
    p (AttValue -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show AttValue
    atv) of
                          Committed Result TargetNamespace a
    r   -> Result TargetNamespace a
    r
                          Failure TargetNamespace
    z TargetNamespace
    msg -> TargetNamespace -> TargetNamespace -> Result TargetNamespace a
    forall z a. z -> TargetNamespace -> Result z a
    Failure TargetNamespace
    z (TargetNamespace -> Result TargetNamespace a)
    -> TargetNamespace -> Result TargetNamespace a
    forall a b. (a -> b) -> a -> b
    $
                                                 TargetNamespace
    "Attribute parsing failure: "
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    qnTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "=\""
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++AttValue -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show AttValue
    atvTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\": "TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    msg
                          Success [] a
    v  -> TargetNamespace -> a -> Result TargetNamespace a
    forall z a. z -> a -> Result z a
    Success [] a
    v
                          Success TargetNamespace
    xs a
    _  -> Result TargetNamespace a -> Result TargetNamespace a
    forall z a. Result z a -> Result z a
    Committed (Result TargetNamespace a -> Result TargetNamespace a)
    -> Result TargetNamespace a -> Result TargetNamespace a
    forall a b. (a -> b) -> a -> b
    $
                                           TargetNamespace -> TargetNamespace -> Result TargetNamespace a
    forall z a. z -> TargetNamespace -> Result z a
    Failure TargetNamespace
    xs (TargetNamespace -> Result TargetNamespace a)
    -> TargetNamespace -> Result TargetNamespace a
    forall a b. (a -> b) -> a -> b
    $
                                                 TargetNamespace
    "Attribute parsing excess text: "
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++QName -> TargetNamespace
    printableName QName
    qnTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "=\""
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++AttValue -> TargetNamespace
    forall a. Show a => a -> TargetNamespace
    show AttValue
    atvTargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    "\":\n  Excess is: "
                                                 TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    xs

    -- | Grab any attributes that declare a locally-used prefix for a
    --   specific namespace.
    namespaceAttrs :: Element Posn -> XsdParser [Namespace]
    namespaceAttrs :: Element Posn -> XsdParser [Namespace]
    namespaceAttrs (Elem QName
    _ [Attribute]
    as [Content Posn]
    _) =
        [Namespace] -> XsdParser [Namespace]
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Namespace] -> XsdParser [Namespace])
    -> ([Attribute] -> [Namespace])
    -> [Attribute]
    -> XsdParser [Namespace]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Attribute -> Namespace) -> [Attribute] -> [Namespace]
    forall a b. (a -> b) -> [a] -> [b]
    map Attribute -> Namespace
    forall {a}. Verbatim a => (QName, a) -> Namespace
    mkNamespace ([Attribute] -> [Namespace])
    -> ([Attribute] -> [Attribute]) -> [Attribute] -> [Namespace]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Attribute -> Bool) -> [Attribute] -> [Attribute]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TargetNamespace -> Attribute -> Bool
    matchNamespace TargetNamespace
    "xmlns") ([Attribute] -> XsdParser [Namespace])
    -> [Attribute] -> XsdParser [Namespace]
    forall a b. (a -> b) -> a -> b
    $ [Attribute]
    as
      where
        deQN :: QName -> TargetNamespace
    deQN (QN Namespace
    _ TargetNamespace
    n) = TargetNamespace
    n
        mkNamespace :: (QName, a) -> Namespace
    mkNamespace (QName
    attname,a
    attval) = Namespace { nsPrefix :: TargetNamespace
    nsPrefix = QName -> TargetNamespace
    deQN QName
    attname
                                                 , nsURI :: TargetNamespace
    nsURI    = a -> TargetNamespace
    forall a. Verbatim a => a -> TargetNamespace
    verbatim a
    attval
                                                 }

    -- | Predicate for whether an attribute belongs to a given namespace.
    matchNamespace :: String -> Attribute -> Bool
    matchNamespace :: TargetNamespace -> Attribute -> Bool
    matchNamespace TargetNamespace
    n (N TargetNamespace
    m,     AttValue
    _) =   Bool
    False  -- (n++":") `isPrefixOf` m
    matchNamespace TargetNamespace
    n (QN Namespace
    ns TargetNamespace
    _, AttValue
    _) =   TargetNamespace
    n TargetNamespace -> TargetNamespace -> Bool
    forall a. Eq a => a -> a -> Bool
    == Namespace -> TargetNamespace
    nsPrefix Namespace
    ns

    -- | Tidy up the parsing context.
    tidy :: t -> Result x a -> Result t a
    tidy :: forall t x a. t -> Result x a -> Result t a
    tidy t
    inp (Committed Result x a
    r) = t -> Result x a -> Result t a
    forall t x a. t -> Result x a -> Result t a
    tidy t
    inp Result x a
    r
    tidy t
    inp (Failure x
    _ TargetNamespace
    m) = t -> TargetNamespace -> Result t a
    forall z a. z -> TargetNamespace -> Result z a
    Failure t
    inp TargetNamespace
    m
    tidy t
    inp (Success x
    _ a
    v) = t -> a -> Result t a
    forall z a. z -> a -> Result z a
    Success t
    inp a
    v

    -- | Given a URI for a targetNamespace, and a list of Namespaces, tell
    --   me the prefix corresponding to the targetNamespace.
    targetPrefix :: Maybe TargetNamespace -> [Namespace] -> Maybe String
    targetPrefix :: Maybe TargetNamespace -> [Namespace] -> Maybe TargetNamespace
    targetPrefix Maybe TargetNamespace
    Nothing    [Namespace]
    _   = Maybe TargetNamespace
    forall a. Maybe a
    Nothing
    targetPrefix (Just TargetNamespace
    uri) [Namespace]
    nss = Namespace -> TargetNamespace
    nsPrefix (Namespace -> TargetNamespace)
    -> Maybe Namespace -> Maybe TargetNamespace
    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 ((TargetNamespace -> TargetNamespace -> Bool
    forall a. Eq a => a -> a -> Bool
    ==TargetNamespace
    uri)(TargetNamespace -> Bool)
    -> (Namespace -> TargetNamespace) -> Namespace -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Namespace -> TargetNamespace
    nsURI) [Namespace]
    nss

    -- | An auxiliary you might expect to find in Data.List
    lookupBy :: (a->Bool) -> [a] -> Maybe a
    lookupBy :: forall a. (a -> Bool) -> [a] -> Maybe a
    lookupBy a -> Bool
    p []     = Maybe a
    forall a. Maybe a
    Nothing
    lookupBy a -> Bool
    p (a
    y:[a]
    ys) | a -> Bool
    p a
    y       = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    y
                      | Bool
    otherwise = (a -> Bool) -> [a] -> Maybe a
    forall a. (a -> Bool) -> [a] -> Maybe a
    lookupBy a -> Bool
    p [a]
    ys

    -- | Turn a qualified attribute value (two strings) into a qualified name
    --   (QName), but excluding the case where the namespace prefix corresponds
    --   to the targetNamespace of the current schema document.
    qual :: Maybe TargetNamespace -> [Namespace] -> String-> String -> QName
    qual :: Maybe TargetNamespace
    -> [Namespace] -> TargetNamespace -> TargetNamespace -> QName
    qual Maybe TargetNamespace
    tn [Namespace]
    nss TargetNamespace
    pre TargetNamespace
    nm = case Maybe TargetNamespace -> [Namespace] -> Maybe TargetNamespace
    targetPrefix Maybe TargetNamespace
    tn [Namespace]
    nss of
                             Maybe TargetNamespace
    Nothing             -> Namespace -> TargetNamespace -> QName
    QN Namespace
    thisNS TargetNamespace
    nm
                             Just TargetNamespace
    p  | TargetNamespace
    pTargetNamespace -> TargetNamespace -> Bool
    forall a. Eq a => a -> a -> Bool
    /=TargetNamespace
    pre    -> Namespace -> TargetNamespace -> QName
    QN Namespace
    thisNS TargetNamespace
    nm
                                     | Bool
    otherwise -> TargetNamespace -> QName
    N TargetNamespace
    nm
        where thisNS :: Namespace
    thisNS = Namespace{ nsPrefix :: TargetNamespace
    nsPrefix = TargetNamespace
    pre
                                , nsURI :: TargetNamespace
    nsURI = TargetNamespace
    -> (Namespace -> TargetNamespace)
    -> Maybe Namespace
    -> TargetNamespace
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TargetNamespace
    "" Namespace -> TargetNamespace
    nsURI (Maybe Namespace -> TargetNamespace)
    -> Maybe Namespace -> TargetNamespace
    forall a b. (a -> b) -> a -> b
    $
                                          (Namespace -> Bool) -> [Namespace] -> Maybe Namespace
    forall a. (a -> Bool) -> [a] -> Maybe a
    lookupBy ((TargetNamespace -> TargetNamespace -> Bool
    forall a. Eq a => a -> a -> Bool
    ==TargetNamespace
    pre)(TargetNamespace -> Bool)
    -> (Namespace -> TargetNamespace) -> Namespace -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Namespace -> TargetNamespace
    nsPrefix) [Namespace]
    nss
                                }

    -- Now for the real parsers.

    -- | Parse a Schema declaration
    schema :: Parser (Content Posn) Schema
    schema = do
        e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "schema"
        commit $ do
            tn  <- optional (attribute (N "targetNamespace") uri e)
            nss <- namespaceAttrs e
            return Schema
              `apply` (attribute (N "elementFormDefault")    qform e
                       `onFail` return Unqualified)
              `apply` (attribute (N "attributeFormDefault")  qform e
                       `onFail` return Unqualified)
              `apply` optional (attribute (xsd "finalDefault") final e)
              `apply` optional (attribute (xsd "blockDefault") block e)
              `apply` return tn
              `apply` optional (attribute (N "version")       string e)
              `apply` return nss
              `apply` interiorWith (const True) (many (schemaItem (qual tn nss))) e

    -- | Parse a (possibly missing) <xsd:annotation> element.
    annotation :: XsdParser Annotation
    annotation :: XsdParser Annotation
    annotation = do
        XsdParser Annotation
    definiteAnnotation XsdParser Annotation
    -> XsdParser Annotation -> XsdParser Annotation
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` Annotation -> XsdParser Annotation
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TargetNamespace -> Annotation
    NoAnnotation TargetNamespace
    "missing")

    -- | Parse a definitely-occurring <xsd:annotation> element.
    definiteAnnotation :: XsdParser Annotation
    definiteAnnotation :: XsdParser Annotation
    definiteAnnotation = do
        e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "annotation"
        ( Documentation <$> interiorWith (xsdTag "documentation")
                                            (allChildren text)  e)
          `onFail`
          (AppInfo <$> interiorWith (xsdTag "documentation")
                                            (allChildren text)  e)
          `onFail`
          return (NoAnnotation "failed to parse")

    -- | Parse a FormDefault attribute.
    qform :: TextParser QForm
    qform :: TextParser QForm
    qform = do
        w <- TextParser TargetNamespace
    word
        case w of
            TargetNamespace
    "qualified"   -> QForm -> TextParser QForm
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QForm
    Qualified
            TargetNamespace
    "unqualified" -> QForm -> TextParser QForm
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QForm
    Unqualified
            TargetNamespace
    _             -> TargetNamespace -> TextParser QForm
    forall (p :: * -> *) a. PolyParse p => TargetNamespace -> p a
    failBad TargetNamespace
    "Expected \"qualified\" or \"unqualified\""

    -- | Parse a Final or Block attribute.
    final :: TextParser Final
    final :: TextParser Final
    final = do
        w <- TextParser TargetNamespace
    word
        case w of
            TargetNamespace
    "restriction" -> Final -> TextParser Final
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Final
    NoRestriction
            TargetNamespace
    "extension"   -> Final -> TextParser Final
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Final
    NoExtension
            TargetNamespace
    "#all"        -> Final -> TextParser Final
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Final
    AllFinal
            TargetNamespace
    _             -> TargetNamespace -> TextParser Final
    forall (p :: * -> *) a. PolyParse p => TargetNamespace -> p a
    failBad (TargetNamespace -> TextParser Final)
    -> TargetNamespace -> TextParser Final
    forall a b. (a -> b) -> a -> b
    $ TargetNamespace
    "Expected \"restriction\" or \"extension\""
                                       TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++TargetNamespace
    " or \"#all\""
    block :: TextParser Block
    block :: TextParser Final
    block = TextParser Final
    final

    -- | Parse a schema item (just under the toplevel <xsd:schema>)
    schemaItem :: (String->String->QName) -> XsdParser SchemaItem
    schemaItem :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SchemaItem
    schemaItem TargetNamespace -> TargetNamespace -> QName
    qual = [(TargetNamespace, Parser (Content Posn) SchemaItem)]
    -> Parser (Content Posn) SchemaItem
    forall a.
    [(TargetNamespace, Parser (Content Posn) a)]
    -> Parser (Content Posn) a
    forall (p :: * -> *) a.
    Commitment p =>
    [(TargetNamespace, p a)] -> p a
    oneOf'
           [ (TargetNamespace
    "xsd:include",        Parser (Content Posn) SchemaItem
    include)
           , (TargetNamespace
    "xsd:import",         Parser (Content Posn) SchemaItem
    import_)
           , (TargetNamespace
    "xsd:redefine",       (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SchemaItem
    redefine TargetNamespace -> TargetNamespace -> QName
    qual)
           , (TargetNamespace
    "xsd:annotation",     (Annotation -> SchemaItem)
    -> XsdParser Annotation -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Annotation -> SchemaItem
    Annotation     XsdParser Annotation
    definiteAnnotation)
             --
           , (TargetNamespace
    "xsd:simpleType",     (SimpleType -> SchemaItem)
    -> Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SimpleType -> SchemaItem
    Simple           ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SimpleType
    simpleType TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xsd:complexType",    (ComplexType -> SchemaItem)
    -> Parser (Content Posn) ComplexType
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ComplexType -> SchemaItem
    Complex          ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ComplexType
    complexType TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xsd:element",        (ElementDecl -> SchemaItem)
    -> Parser (Content Posn) ElementDecl
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ElementDecl -> SchemaItem
    SchemaElement    ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ElementDecl
    elementDecl TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xsd:attribute",      (AttributeDecl -> SchemaItem)
    -> Parser (Content Posn) AttributeDecl
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttributeDecl -> SchemaItem
    SchemaAttribute  ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttributeDecl
    attributeDecl TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xsd:attributeGroup", (AttrGroup -> SchemaItem)
    -> Parser (Content Posn) AttrGroup
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttrGroup -> SchemaItem
    AttributeGroup   ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttrGroup
    attributeGroup TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xsd:group",          (Group -> SchemaItem)
    -> Parser (Content Posn) Group -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Group -> SchemaItem
    SchemaGroup      ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Group
    group_ TargetNamespace -> TargetNamespace -> QName
    qual))
       --  , ("xsd:notation",       notation)
    -- sigh
           , (TargetNamespace
    "xs:include",        Parser (Content Posn) SchemaItem
    include)
           , (TargetNamespace
    "xs:import",         Parser (Content Posn) SchemaItem
    import_)
           , (TargetNamespace
    "xs:redefine",       (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SchemaItem
    redefine TargetNamespace -> TargetNamespace -> QName
    qual)
           , (TargetNamespace
    "xs:annotation",     (Annotation -> SchemaItem)
    -> XsdParser Annotation -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Annotation -> SchemaItem
    Annotation     XsdParser Annotation
    definiteAnnotation)
             --
           , (TargetNamespace
    "xs:simpleType",     (SimpleType -> SchemaItem)
    -> Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SimpleType -> SchemaItem
    Simple           ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SimpleType
    simpleType TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xs:complexType",    (ComplexType -> SchemaItem)
    -> Parser (Content Posn) ComplexType
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ComplexType -> SchemaItem
    Complex          ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ComplexType
    complexType TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xs:element",        (ElementDecl -> SchemaItem)
    -> Parser (Content Posn) ElementDecl
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ElementDecl -> SchemaItem
    SchemaElement    ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ElementDecl
    elementDecl TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xs:attribute",      (AttributeDecl -> SchemaItem)
    -> Parser (Content Posn) AttributeDecl
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttributeDecl -> SchemaItem
    SchemaAttribute  ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttributeDecl
    attributeDecl TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xs:attributeGroup", (AttrGroup -> SchemaItem)
    -> Parser (Content Posn) AttrGroup
    -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttrGroup -> SchemaItem
    AttributeGroup   ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttrGroup
    attributeGroup TargetNamespace -> TargetNamespace -> QName
    qual))
           , (TargetNamespace
    "xs:group",          (Group -> SchemaItem)
    -> Parser (Content Posn) Group -> Parser (Content Posn) SchemaItem
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Group -> SchemaItem
    SchemaGroup      ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Group
    group_ TargetNamespace -> TargetNamespace -> QName
    qual))
       --  , ("xs:notation",       notation)
           ]

    -- | Parse an <xsd:include>.
    include :: XsdParser SchemaItem
    include :: Parser (Content Posn) SchemaItem
    include = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "include"
                 commit $ return Include
                          `apply` attribute (N "schemaLocation") uri e
                          `apply` interiorWith (xsdTag "annotation") annotation e

    -- | Parse an <xsd:import>.
    import_ :: XsdParser SchemaItem
    import_ :: Parser (Content Posn) SchemaItem
    import_ = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "import"
                 commit $ return Import
                          `apply` attribute (N "namespace")      uri e
                          `apply` attribute (N "schemaLocation") uri e
                          `apply` interiorWith (xsdTag "annotation") annotation e

    -- | Parse a <xsd:redefine>.
    redefine :: (String->String->QName) -> XsdParser SchemaItem
    redefine :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SchemaItem
    redefine TargetNamespace -> TargetNamespace -> QName
    q = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "redefine"
                    commit $ return Redefine
                         `apply` attribute (N "schemaLocation") uri e
                         `apply` interiorWith (const True) (many (schemaItem q)) e

    -- | Parse a <xsd:simpleType> decl.
    simpleType :: (String->String->QName) -> XsdParser SimpleType
    simpleType :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SimpleType
    simpleType TargetNamespace -> TargetNamespace -> QName
    q = do
        e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "simpleType"
        n <- optional (attribute (N "name") string e)
        f <- optional (attribute (N "final") final e)
        a <- interiorWith (xsdTag "annotation") annotation e
        commit $ interiorWith (not . xsdTag "annotation") (simpleItem n f a) e
      where
        simpleItem :: Maybe TargetNamespace
    -> Maybe Final -> Annotation -> Parser (Content Posn) SimpleType
    simpleItem Maybe TargetNamespace
    n Maybe Final
    f Annotation
    a =
            do e  <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "restriction"
               commit $ do
                 a1 <- interiorWith (xsdTag "annotation") annotation e
                 b  <- optional (attribute (N "base") (qname q) e)
                 r  <- interiorWith (not . xsdTag "annotation")
                                    (restrictType a1 b `onFail` restriction1 a1 b) e
                 return (Restricted a n f r)
            Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SimpleType
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
            do e  <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "list"
               commit $ do
                 a1 <- interiorWith (xsdTag "annotation") annotation e
                 t  <- attribute (N "itemType") (fmap Right (qname q)) e
                         `onFail`
                       interiorWith (xsdTag "simpleType")
                                    (fmap Left (simpleType q)) e
                         `adjustErr`
                       (("Expected attribute 'itemType' or element <simpleType>\n"
                        ++"  inside <list> decl.\n")++)
                 return (ListOf (a`mappend`a1) n f t)
            Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SimpleType
    -> Parser (Content Posn) SimpleType
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
            do e  <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "union"
               commit $ do
                 a1 <- interiorWith (xsdTag "annotation") annotation e
                 ts <- interiorWith (xsdTag "simpleType") (many (simpleType q)) e
                 ms <- attribute (N "memberTypes") (many (qname q)) e
                       `onFail` return []
                 return (UnionOf (a`mappend`a1) n f ts ms)
            Parser (Content Posn) SimpleType
    -> (TargetNamespace -> TargetNamespace)
    -> Parser (Content Posn) SimpleType
    forall a.
    Parser (Content Posn) a
    -> (TargetNamespace -> TargetNamespace) -> Parser (Content Posn) a
    forall (p :: * -> *) a.
    Commitment p =>
    p a -> (TargetNamespace -> TargetNamespace) -> p a
    `adjustErr`
            (TargetNamespace
    "xsd:simpleType does not contain a restriction, list, or union\n"TargetNamespace -> TargetNamespace -> TargetNamespace
    forall a. [a] -> [a] -> [a]
    ++)

        restriction1 :: Annotation -> Maybe QName -> XsdParser Restriction
    restriction1 Annotation
    a Maybe QName
    b = (Restriction1 -> Restriction)
    -> Parser (Content Posn) (Restriction1 -> Restriction)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Annotation -> Maybe QName -> Restriction1 -> Restriction
    RestrictSim1 Annotation
    a Maybe QName
    b)
                                Parser (Content Posn) (Restriction1 -> Restriction)
    -> Parser (Content Posn) Restriction1 -> XsdParser Restriction
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` ((Particle -> Restriction1)
    -> Parser (Content Posn) (Particle -> Restriction1)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Particle -> Restriction1
    Restriction1 Parser (Content Posn) (Particle -> Restriction1)
    -> Parser (Content Posn) Particle
    -> Parser (Content Posn) Restriction1
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Particle
    particle TargetNamespace -> TargetNamespace -> QName
    q)
        restrictType :: Annotation -> Maybe QName -> XsdParser Restriction
    restrictType Annotation
    a Maybe QName
    b = (Maybe SimpleType -> [Facet] -> Restriction)
    -> Parser
         (Content Posn) (Maybe SimpleType -> [Facet] -> Restriction)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Annotation
    -> Maybe QName -> Maybe SimpleType -> [Facet] -> Restriction
    RestrictType Annotation
    a Maybe QName
    b)
                                Parser (Content Posn) (Maybe SimpleType -> [Facet] -> Restriction)
    -> Parser (Content Posn) (Maybe SimpleType)
    -> Parser (Content Posn) ([Facet] -> Restriction)
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) SimpleType
    -> Parser (Content Posn) (Maybe SimpleType)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) SimpleType
    simpleType TargetNamespace -> TargetNamespace -> QName
    q)
                                Parser (Content Posn) ([Facet] -> Restriction)
    -> Parser (Content Posn) [Facet] -> XsdParser Restriction
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) Facet -> Parser (Content Posn) [Facet]
    forall (p :: * -> *) a. PolyParse p => p a -> p [a]
    many1 Parser (Content Posn) Facet
    aFacet

    aFacet :: XsdParser Facet
    aFacet :: Parser (Content Posn) Facet
    aFacet = (Parser (Content Posn) Facet
     -> Parser (Content Posn) Facet -> Parser (Content Posn) Facet)
    -> Parser (Content Posn) Facet
    -> [Parser (Content Posn) Facet]
    -> Parser (Content Posn) Facet
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Parser (Content Posn) Facet
    -> Parser (Content Posn) Facet -> Parser (Content Posn) Facet
    forall t a. Parser t a -> Parser t a -> Parser t a
    onFail (TargetNamespace -> Parser (Content Posn) Facet
    forall a. TargetNamespace -> Parser (Content Posn) a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail TargetNamespace
    "Could not recognise simpleType Facet")
                   ((TargetNamespace -> FacetType -> Parser (Content Posn) Facet)
    -> [TargetNamespace]
    -> [FacetType]
    -> [Parser (Content Posn) Facet]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith TargetNamespace -> FacetType -> Parser (Content Posn) Facet
    facet [TargetNamespace
    "minInclusive",TargetNamespace
    "minExclusive",TargetNamespace
    "maxInclusive"
                                  ,TargetNamespace
    "maxExclusive",TargetNamespace
    "totalDigits",TargetNamespace
    "fractionDigits"
                                  ,TargetNamespace
    "length",TargetNamespace
    "minLength",TargetNamespace
    "maxLength"
                                  ,TargetNamespace
    "enumeration",TargetNamespace
    "whiteSpace",TargetNamespace
    "pattern"]
                                  [FacetType
    OrderedBoundsMinIncl,FacetType
    OrderedBoundsMinExcl
                                  ,FacetType
    OrderedBoundsMaxIncl,FacetType
    OrderedBoundsMaxExcl
                                  ,FacetType
    OrderedNumericTotalDigits
                                  ,FacetType
    OrderedNumericFractionDigits
                                  ,FacetType
    UnorderedLength,FacetType
    UnorderedMinLength
                                  ,FacetType
    UnorderedMaxLength,FacetType
    UnorderedEnumeration
                                  ,FacetType
    UnorderedWhitespace,FacetType
    UnorderedPattern])

    facet :: String -> FacetType -> XsdParser Facet
    facet :: TargetNamespace -> FacetType -> Parser (Content Posn) Facet
    facet TargetNamespace
    s FacetType
    t = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    s
                   v <- attribute (N "value") string e
                   f <- attribute (N "fixed") bool e
                        `onFail` return False -- XXX check this
                   a <- interiorWith (const True) annotation e
                   return (Facet t a v f)

    -- | Parse a <xsd:complexType> decl.
    complexType :: (String->String->QName) -> XsdParser ComplexType
    complexType :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ComplexType
    complexType TargetNamespace -> TargetNamespace -> QName
    q =
        do e  <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "complexType"
           commit $ return ComplexType
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` optional (attribute (N "name") string e)
               `apply` (attribute (N "abstract") bool e `onFail` return False)
               `apply` optional (attribute (N "final") final e)
               `apply` optional (attribute (N "block") block e)
               `apply` (attribute (N "mixed") bool e `onFail` return False)
               `apply` interiorWith (not . xsdTag "annotation") (complexItem q) e

    -- | Parse the alternative contents of a <xsd:complexType> decl.
    complexItem :: (String->String->QName) -> XsdParser ComplexItem
    complexItem :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ComplexItem
    complexItem TargetNamespace -> TargetNamespace -> QName
    q =
        ( do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "simpleContent"
             commit $ return SimpleContent
                    `apply` interiorWith (xsdTag "annotation") annotation e
                    `apply` interiorWith (not.xsdTag "annotation") stuff e
        ) Parser (Content Posn) ComplexItem
    -> Parser (Content Posn) ComplexItem
    -> Parser (Content Posn) ComplexItem
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` (
          do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "complexContent"
             commit $ return ComplexContent
                    `apply` interiorWith (xsdTag "annotation") annotation e
                    `apply` (attribute (N "mixed") bool e `onFail` return False)
                    `apply` interiorWith (not.xsdTag "annotation") stuff e
        ) Parser (Content Posn) ComplexItem
    -> Parser (Content Posn) ComplexItem
    -> Parser (Content Posn) ComplexItem
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` (
          do ParticleAttrs -> ComplexItem
    ThisType (ParticleAttrs -> ComplexItem)
    -> Parser (Content Posn) ParticleAttrs
    -> Parser (Content Posn) ComplexItem
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ParticleAttrs
    particleAttrs TargetNamespace -> TargetNamespace -> QName
    q
        )
      where
        stuff :: XsdParser (Either Restriction1 Extension)
        stuff :: Parser (Content Posn) (Either Restriction1 Extension)
    stuff =
          ( do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "restriction"
               commit $ fmap Left $ return Restriction1 `apply` particle q
          ) Parser (Content Posn) (Either Restriction1 Extension)
    -> Parser (Content Posn) (Either Restriction1 Extension)
    -> Parser (Content Posn) (Either Restriction1 Extension)
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` (
            do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "extension"
               commit $ fmap Right $ return Extension
                   `apply` interiorWith (xsdTag "annotation") annotation e
                   `apply` attribute (N "base") (qname q) e
                   `apply` interiorWith (not.xsdTag "annotation")
                                        (particleAttrs q) e
          )

    -- | Parse a particle decl.
    particle :: (String->String->QName) -> XsdParser Particle
    particle :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Particle
    particle TargetNamespace -> TargetNamespace -> QName
    q = Parser (Content Posn) (Either ChoiceOrSeq Group)
    -> Parser (Content Posn) Particle
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ((ChoiceOrSeq -> Either ChoiceOrSeq Group)
    -> Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) (Either ChoiceOrSeq Group)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ChoiceOrSeq -> Either ChoiceOrSeq Group
    forall a b. a -> Either a b
    Left ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ChoiceOrSeq
    choiceOrSeq TargetNamespace -> TargetNamespace -> QName
    q) Parser (Content Posn) (Either ChoiceOrSeq Group)
    -> Parser (Content Posn) (Either ChoiceOrSeq Group)
    -> Parser (Content Posn) (Either ChoiceOrSeq Group)
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` (Group -> Either ChoiceOrSeq Group)
    -> Parser (Content Posn) Group
    -> Parser (Content Posn) (Either ChoiceOrSeq Group)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Group -> Either ChoiceOrSeq Group
    forall a b. b -> Either a b
    Right ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Group
    group_ TargetNamespace -> TargetNamespace -> QName
    q))

    -- | Parse a particle decl with optional attributes.
    particleAttrs :: (String->String->QName) -> XsdParser ParticleAttrs
    particleAttrs :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ParticleAttrs
    particleAttrs TargetNamespace -> TargetNamespace -> QName
    q = (Particle
     -> [Either AttributeDecl AttrGroup]
     -> Maybe AnyAttr
     -> ParticleAttrs)
    -> Parser
         (Content Posn)
         (Particle
          -> [Either AttributeDecl AttrGroup]
          -> Maybe AnyAttr
          -> ParticleAttrs)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Particle
    -> [Either AttributeDecl AttrGroup]
    -> Maybe AnyAttr
    -> ParticleAttrs
    PA Parser
      (Content Posn)
      (Particle
       -> [Either AttributeDecl AttrGroup]
       -> Maybe AnyAttr
       -> ParticleAttrs)
    -> Parser (Content Posn) Particle
    -> Parser
         (Content Posn)
         ([Either AttributeDecl AttrGroup]
          -> Maybe AnyAttr -> ParticleAttrs)
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Particle
    particle TargetNamespace -> TargetNamespace -> QName
    q
                                Parser
      (Content Posn)
      ([Either AttributeDecl AttrGroup]
       -> Maybe AnyAttr -> ParticleAttrs)
    -> Parser (Content Posn) [Either AttributeDecl AttrGroup]
    -> Parser (Content Posn) (Maybe AnyAttr -> ParticleAttrs)
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) (Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) [Either AttributeDecl AttrGroup]
    forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((AttributeDecl -> Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) AttributeDecl
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttributeDecl -> Either AttributeDecl AttrGroup
    forall a b. a -> Either a b
    Left ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttributeDecl
    attributeDecl TargetNamespace -> TargetNamespace -> QName
    q)
                                              Parser (Content Posn) (Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                                              (AttrGroup -> Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) AttrGroup
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttrGroup -> Either AttributeDecl AttrGroup
    forall a b. b -> Either a b
    Right ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttrGroup
    attributeGroup TargetNamespace -> TargetNamespace -> QName
    q))
                                Parser (Content Posn) (Maybe AnyAttr -> ParticleAttrs)
    -> Parser (Content Posn) (Maybe AnyAttr)
    -> Parser (Content Posn) ParticleAttrs
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) AnyAttr
    -> Parser (Content Posn) (Maybe AnyAttr)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional Parser (Content Posn) AnyAttr
    anyAttr

    -- | Parse an <xsd:all>, <xsd:choice>, or <xsd:sequence> decl.
    choiceOrSeq :: (String->String->QName) -> XsdParser ChoiceOrSeq
    choiceOrSeq :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ChoiceOrSeq
    choiceOrSeq TargetNamespace -> TargetNamespace -> QName
    q =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "all"
           commit $ return All
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` interiorWith (not.xsdTag "annotation")
                                    (many (elementDecl q)) e
        Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) ChoiceOrSeq
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "choice"
           commit $ return Choice
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` occurs e
               `apply` interiorWith (not.xsdTag "annotation")
                                    (many (elementEtc q)) e
        Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) ChoiceOrSeq
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "sequence"
           commit $ return Sequence
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` occurs e
               `apply` interiorWith (not.xsdTag "annotation")
                                    (many (elementEtc q)) e

    -- | Parse a <xsd:group> decl.
    group_ :: (String->String->QName) -> XsdParser Group
    group_ :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Group
    group_ TargetNamespace -> TargetNamespace -> QName
    q = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "group"
                  commit $ return Group
                    `apply` interiorWith (xsdTag "annotation") annotation e
                    `apply` (fmap Left (attribute (N "name") string e)
                             `onFail`
                             fmap Right (attribute (N "ref") (qname q) e))
                    `apply` occurs e
                    `apply` interiorWith (not.xsdTag "annotation")
                                         (optional (choiceOrSeq q)) e

    -- | Parse an <xsd:element>, <xsd:group>, <xsd:all>, <xsd:choice>,
    --   <xsd:sequence> or <xsd:any>.
    elementEtc :: (String->String->QName) -> XsdParser ElementEtc
    elementEtc :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ElementEtc
    elementEtc TargetNamespace -> TargetNamespace -> QName
    q = (ElementDecl -> ElementEtc)
    -> Parser (Content Posn) ElementDecl
    -> Parser (Content Posn) ElementEtc
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ElementDecl -> ElementEtc
    HasElement ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ElementDecl
    elementDecl TargetNamespace -> TargetNamespace -> QName
    q)
                 Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                 (Group -> ElementEtc)
    -> Parser (Content Posn) Group -> Parser (Content Posn) ElementEtc
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Group -> ElementEtc
    HasGroup ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) Group
    group_ TargetNamespace -> TargetNamespace -> QName
    q)
                 Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                 (ChoiceOrSeq -> ElementEtc)
    -> Parser (Content Posn) ChoiceOrSeq
    -> Parser (Content Posn) ElementEtc
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ChoiceOrSeq -> ElementEtc
    HasCS ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ChoiceOrSeq
    choiceOrSeq TargetNamespace -> TargetNamespace -> QName
    q)
                 Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    -> Parser (Content Posn) ElementEtc
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                 (Any -> ElementEtc)
    -> Parser (Content Posn) Any -> Parser (Content Posn) ElementEtc
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Any -> ElementEtc
    HasAny Parser (Content Posn) Any
    any_

    -- | Parse an <xsd:any>.
    any_ :: XsdParser Any
    any_ :: Parser (Content Posn) Any
    any_ = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "any"
              commit $ return Any
                  `apply` interiorWith (xsdTag "annotation") annotation e
                  `apply` (attribute (N "namespace") uri e
                           `onFail` return "##any")
                  `apply` (attribute (N "processContents") processContents e
                           `onFail` return Strict)
                  `apply` occurs e

    -- | Parse an <xsd:anyAttribute>.
    anyAttr :: XsdParser AnyAttr
    anyAttr :: Parser (Content Posn) AnyAttr
    anyAttr = do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "anyAttribute"
                 commit $ return AnyAttr
                     `apply` interiorWith (xsdTag "annotation") annotation e
                     `apply` (attribute (N "namespace") uri e
                              `onFail` return "##any")
                     `apply` (attribute (N "processContents") processContents e
                              `onFail` return Strict)

    -- | Parse an <xsd:attributegroup>.
    attributeGroup :: (String->String->QName) -> XsdParser AttrGroup
    attributeGroup :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttrGroup
    attributeGroup TargetNamespace -> TargetNamespace -> QName
    q =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "attributeGroup"
           commit $ return AttrGroup
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` (fmap Left (attribute (N "name") string e)
                        `onFail`
                        fmap Right (attribute (N "ref") (qname q) e))
               `apply` interiorWith (not.xsdTag "annotation") (many stuff) e
      where
        stuff :: Parser (Content Posn) (Either AttributeDecl AttrGroup)
    stuff = (AttributeDecl -> Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) AttributeDecl
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttributeDecl -> Either AttributeDecl AttrGroup
    forall a b. a -> Either a b
    Left ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttributeDecl
    attributeDecl TargetNamespace -> TargetNamespace -> QName
    q) Parser (Content Posn) (Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` (AttrGroup -> Either AttributeDecl AttrGroup)
    -> Parser (Content Posn) AttrGroup
    -> Parser (Content Posn) (Either AttributeDecl AttrGroup)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap AttrGroup -> Either AttributeDecl AttrGroup
    forall a b. b -> Either a b
    Right ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttrGroup
    attributeGroup TargetNamespace -> TargetNamespace -> QName
    q)

    -- | Parse an <xsd:element> decl.
    elementDecl :: (String->String->QName) -> XsdParser ElementDecl
    elementDecl :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) ElementDecl
    elementDecl TargetNamespace -> TargetNamespace -> QName
    q =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "element"
           commit $ return ElementDecl
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` (fmap Left (nameAndType q e)
                        `onFail`
                        fmap Right (attribute (N "ref") (qname q) e))
               `apply` occurs e
               `apply` (attribute (N "nillable") bool e `onFail` return False)
               `apply` optional (attribute (N "substitutionGroup") (qname q) e)
               `apply` (attribute (N "abstract") bool e `onFail` return False)
               `apply` optional (attribute (xsd "final") final e)
               `apply` optional (attribute (xsd "block") block e)
               `apply` (attribute (xsd "form") qform e `onFail` return Unqualified)
               `apply` interiorWith (xsdTag "simpleType" ||| xsdTag "complexType")
                                    (optional (fmap Left (simpleType q)
                                               `onFail`
                                               fmap Right (complexType q))) e
               `apply` interiorWith (xsdTag "unique" ||| xsdTag "key"
                                                     ||| xsdTag "keyRef")
                                    (many (uniqueKeyOrKeyRef q)) e

    -- | Parse name and type attributes.
    nameAndType :: (String->String->QName) -> Element Posn -> XsdParser NameAndType
    nameAndType :: (TargetNamespace -> TargetNamespace -> QName)
    -> Element Posn -> Parser (Content Posn) NameAndType
    nameAndType TargetNamespace -> TargetNamespace -> QName
    q Element Posn
    e = (TargetNamespace -> Maybe QName -> NameAndType)
    -> Parser
         (Content Posn) (TargetNamespace -> Maybe QName -> NameAndType)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TargetNamespace -> Maybe QName -> NameAndType
    NT Parser
      (Content Posn) (TargetNamespace -> Maybe QName -> NameAndType)
    -> Parser (Content Posn) TargetNamespace
    -> Parser (Content Posn) (Maybe QName -> NameAndType)
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` QName
    -> TextParser TargetNamespace
    -> Element Posn
    -> Parser (Content Posn) TargetNamespace
    forall a. QName -> TextParser a -> Element Posn -> XsdParser a
    attribute (TargetNamespace -> QName
    N TargetNamespace
    "name") TextParser TargetNamespace
    string Element Posn
    e
                                Parser (Content Posn) (Maybe QName -> NameAndType)
    -> Parser (Content Posn) (Maybe QName)
    -> Parser (Content Posn) NameAndType
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) QName -> Parser (Content Posn) (Maybe QName)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (QName
    -> TextParser QName -> Element Posn -> Parser (Content Posn) QName
    forall a. QName -> TextParser a -> Element Posn -> XsdParser a
    attribute (TargetNamespace -> QName
    N TargetNamespace
    "type") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
    qname TargetNamespace -> TargetNamespace -> QName
    q) Element Posn
    e)

    -- | Parse an <xsd:attribute> decl.
    attributeDecl :: (String->String->QName) -> XsdParser AttributeDecl
    attributeDecl :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) AttributeDecl
    attributeDecl TargetNamespace -> TargetNamespace -> QName
    q =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "attribute"
           commit $ return AttributeDecl
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` (fmap Left (nameAndType q e)
                        `onFail`
                        fmap Right (attribute (N "ref") (qname q) e))
               `apply` (attribute (N "use") use e `onFail` return Optional)
               `apply` optional (attribute (N "default") (fmap Left string) e
                                  `onFail`
                                  attribute (N "fixed") (fmap Right string) e)
               `apply` (attribute (xsd "form") qform e `onFail` return Unqualified)
               `apply` interiorWith (xsdTag "simpleType")
                                    (optional (simpleType q)) e

    -- | Parse an occurrence range from attributes of given element.
    occurs :: Element Posn -> XsdParser Occurs
    occurs :: Element Posn -> Parser (Content Posn) Occurs
    occurs Element Posn
    e = (Maybe Int -> Maybe Int -> Occurs)
    -> Parser (Content Posn) (Maybe Int -> Maybe Int -> Occurs)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int -> Maybe Int -> Occurs
    Occurs
                   Parser (Content Posn) (Maybe Int -> Maybe Int -> Occurs)
    -> Parser (Content Posn) (Maybe Int)
    -> Parser (Content Posn) (Maybe Int -> Occurs)
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) Int -> Parser (Content Posn) (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (QName
    -> TextParser Int -> Element Posn -> Parser (Content Posn) Int
    forall a. QName -> TextParser a -> Element Posn -> XsdParser a
    attribute (TargetNamespace -> QName
    N TargetNamespace
    "minOccurs") TextParser Int
    forall a. Integral a => TextParser a
    parseDec Element Posn
    e)
                   Parser (Content Posn) (Maybe Int -> Occurs)
    -> Parser (Content Posn) (Maybe Int)
    -> Parser (Content Posn) Occurs
    forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
    `apply` Parser (Content Posn) Int -> Parser (Content Posn) (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (QName
    -> TextParser Int -> Element Posn -> Parser (Content Posn) Int
    forall a. QName -> TextParser a -> Element Posn -> XsdParser a
    attribute (TargetNamespace -> QName
    N TargetNamespace
    "maxOccurs") TextParser Int
    maxDec Element Posn
    e)
      where
        maxDec :: TextParser Int
    maxDec = TextParser Int
    forall a. Integral a => TextParser a
    parseDec
                 TextParser Int -> TextParser Int -> TextParser Int
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                 do TargetNamespace -> TextParser TargetNamespace
    isWord TargetNamespace
    "unbounded"; Int -> TextParser Int
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    forall a. Bounded a => a
    maxBound

    -- | Parse a <xsd:unique>, <xsd:key>, or <xsd:keyref>.
    uniqueKeyOrKeyRef :: (String->String->QName) -> XsdParser UniqueKeyOrKeyRef
    uniqueKeyOrKeyRef :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    uniqueKeyOrKeyRef TargetNamespace -> TargetNamespace -> QName
    q = (Unique -> UniqueKeyOrKeyRef)
    -> Parser (Content Posn) Unique
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Unique -> UniqueKeyOrKeyRef
    U Parser (Content Posn) Unique
    unique Parser (Content Posn) UniqueKeyOrKeyRef
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                          (Key -> UniqueKeyOrKeyRef)
    -> Parser (Content Posn) Key
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Key -> UniqueKeyOrKeyRef
    K Parser (Content Posn) Key
    key Parser (Content Posn) UniqueKeyOrKeyRef
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
                          (KeyRef -> UniqueKeyOrKeyRef)
    -> Parser (Content Posn) KeyRef
    -> Parser (Content Posn) UniqueKeyOrKeyRef
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap KeyRef -> UniqueKeyOrKeyRef
    KR ((TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) KeyRef
    keyRef TargetNamespace -> TargetNamespace -> QName
    q)

    -- | Parse a <xsd:unique>.
    unique :: XsdParser Unique
    unique :: Parser (Content Posn) Unique
    unique =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "unique"
           commit $ return Unique
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` attribute (N "name") string e
               `apply` interiorWith (xsdTag "selector") selector e
               `apply` interiorWith (xsdTag "field") (many1 field_) e

    -- | Parse a <xsd:key>.
    key :: XsdParser Key
    key :: Parser (Content Posn) Key
    key =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "key"
           commit $ return Key
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` attribute (N "name") string e
               `apply` interiorWith (xsdTag "selector") selector e
               `apply` interiorWith (xsdTag "field") (many1 field_) e

    -- | Parse a <xsd:keyref>.
    keyRef :: (String->String->QName) -> XsdParser KeyRef
    keyRef :: (TargetNamespace -> TargetNamespace -> QName)
    -> Parser (Content Posn) KeyRef
    keyRef TargetNamespace -> TargetNamespace -> QName
    q =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "keyref"
           commit $ return KeyRef
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` attribute (N "name") string e
               `apply` attribute (N "refer") (qname q) e
               `apply` interiorWith (xsdTag "selector") selector e
               `apply` interiorWith (xsdTag "field") (many1 field_) e

    -- | Parse a <xsd:selector>.
    selector :: XsdParser Selector
    selector :: Parser (Content Posn) Selector
    selector =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "selector"
           commit $ return Selector
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` attribute (N "xpath") string e

    -- | Parse a <xsd:field>.
    field_ :: XsdParser Field
    field_ :: Parser (Content Posn) Field
    field_ =
        do e <- TargetNamespace -> XsdParser (Element Posn)
    xsdElement TargetNamespace
    "field"
           commit $ return Field
               `apply` interiorWith (xsdTag "annotation") annotation e
               `apply` attribute (N "xpath") string e

    -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

    -- | Text parser for a URI (very simple, non-validating, probably incorrect).
    uri :: TextParser String
    uri :: TextParser TargetNamespace
    uri = TextParser TargetNamespace
    string

    -- | Text parser for an arbitrary string consisting of possibly multiple tokens.
    string :: TextParser String
    string :: TextParser TargetNamespace
    string = [TargetNamespace] -> TargetNamespace
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([TargetNamespace] -> TargetNamespace)
    -> Parser Char [TargetNamespace] -> TextParser TargetNamespace
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TextParser TargetNamespace -> Parser Char [TargetNamespace]
    forall a. Parser Char a -> Parser Char [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (TextParser TargetNamespace
    space TextParser TargetNamespace
    -> TextParser TargetNamespace -> TextParser TargetNamespace
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail` TextParser TargetNamespace
    word)

    space :: TextParser String
    space :: TextParser TargetNamespace
    space = Parser Char Char -> TextParser TargetNamespace
    forall (p :: * -> *) a. PolyParse p => p a -> p [a]
    many1 (Parser Char Char -> TextParser TargetNamespace)
    -> Parser Char Char -> TextParser TargetNamespace
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Parser Char Char
    forall t. (t -> Bool) -> Parser t t
    satisfy Char -> Bool
    isSpace

    -- | Parse a textual boolean, i.e. "true", "false", "0", or "1"
    bool :: TextParser Bool
    bool :: TextParser Bool
    bool = do w <- TextParser TargetNamespace
    word
              case w of
                TargetNamespace
    "true"  -> Bool -> TextParser Bool
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                TargetNamespace
    "false" -> Bool -> TextParser Bool
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                TargetNamespace
    "0"     -> Bool -> TextParser Bool
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                TargetNamespace
    "1"     -> Bool -> TextParser Bool
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                TargetNamespace
    _       -> TargetNamespace -> TextParser Bool
    forall a. TargetNamespace -> Parser Char a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail TargetNamespace
    "could not parse boolean value"

    -- | Parse a "use" attribute value, i.e. "required", "optional", or "prohibited"
    use :: TextParser Use
    use :: TextParser Use
    use = do w <- TextParser TargetNamespace
    word
             case w of
               TargetNamespace
    "required"   -> Use -> TextParser Use
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Use
    Required
               TargetNamespace
    "optional"   -> Use -> TextParser Use
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Use
    Optional
               TargetNamespace
    "prohibited" -> Use -> TextParser Use
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Use
    Prohibited
               TargetNamespace
    _            -> TargetNamespace -> TextParser Use
    forall a. TargetNamespace -> Parser Char a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail TargetNamespace
    "could not parse \"use\" attribute value"

    -- | Parse a "processContents" attribute, i.e. "skip", "lax", or "strict".
    processContents :: TextParser ProcessContents
    processContents :: TextParser ProcessContents
    processContents =
        do w <- TextParser TargetNamespace
    word
           case w of
             TargetNamespace
    "skip"   -> ProcessContents -> TextParser ProcessContents
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcessContents
    Skip
             TargetNamespace
    "lax"    -> ProcessContents -> TextParser ProcessContents
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcessContents
    Lax
             TargetNamespace
    "strict" -> ProcessContents -> TextParser ProcessContents
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcessContents
    Strict
             TargetNamespace
    _        -> TargetNamespace -> TextParser ProcessContents
    forall a. TargetNamespace -> Parser Char a
    forall (m :: * -> *) a. MonadFail m => TargetNamespace -> m a
    fail TargetNamespace
    "could not parse \"processContents\" attribute value"

    -- | Parse an attribute value that should be a QName.
    qname :: (String->String->QName) -> TextParser QName
    qname :: (TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
    qname TargetNamespace -> TargetNamespace -> QName
    q = do a <- TextParser TargetNamespace
    word
                 do ":" <- word
                    b   <- many (satisfy (/=':'))
                    return (q a b)
                   `onFail`
                     do cs <- many next
                        return (N (a++cs))