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 ||| :: (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 :: Name -> QName
xsd = Namespace -> Name -> QName
QN Namespace :: Name -> Name -> Namespace
Namespace{nsPrefix :: Name
nsPrefix=Name
"xsd",nsURI :: Name
nsURI=Name
"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 :: Name -> Content Posn -> Bool
xsdTag Name
tag (CElem (Elem QName
qn [Attribute]
_ [Content Posn]
_) Posn
_)  =  QName
qn QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> QName
xsd Name
tag Bool -> Bool -> Bool
|| QName
qn QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> QName
N Name
tag
xsdTag Name
_   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) -> [Name] -> XsdParser (Posn, Element Posn)
posnElementWith Content Posn -> Bool
match [Name]
tags = do
    { Content Posn
c <- Parser (Content Posn) (Content Posn)
forall t. Parser t t
next Parser (Content Posn) (Content Posn)
-> (Name -> Name) -> Parser (Content Posn) (Content Posn)
forall (p :: * -> *) a.
Commitment p =>
p a -> (Name -> Name) -> p a
`adjustErr` (Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
" when expecting "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
formatted [Name]
tags)
    ; case Content Posn
c of
        CElem Element Posn
e Posn
pos
            | Content Posn -> Bool
match Content Posn
c   -> (Posn, Element Posn) -> XsdParser (Posn, Element Posn)
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 -> Name -> XsdParser (Posn, Element Posn)
forall (m :: * -> *) a. MonadFail m => Name -> m a
fail (Name
"Found a <"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
t
                                 Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
">, but expected "
                                 Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
formatted [Name]
tagsName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\nat "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Posn -> Name
forall a. Show a => a -> Name
show Posn
pos)
        CString Bool
b Name
s Posn
pos  -- ignore blank space
            | Bool -> Bool
not Bool
b Bool -> Bool -> Bool
&& (Char -> Bool) -> Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Name
s -> (Content Posn -> Bool) -> [Name] -> XsdParser (Posn, Element Posn)
posnElementWith Content Posn -> Bool
match [Name]
tags
            | Bool
otherwise -> Name -> XsdParser (Posn, Element Posn)
forall (m :: * -> *) a. MonadFail m => Name -> m a
fail (Name
"Found text content, but expected "
                                 Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
formatted [Name]
tagsName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\ntext is: "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
s
                                 Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\nat "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Posn -> Name
forall a. Show a => a -> Name
show Posn
pos)
        CRef Reference
r Posn
pos -> Name -> XsdParser (Posn, Element Posn)
forall (m :: * -> *) a. MonadFail m => Name -> m a
fail (Name
"Found reference, but expected "
                            Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Name] -> Name
formatted [Name]
tagsName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\nreference is: "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Reference -> Name
forall a. Verbatim a => a -> Name
verbatim Reference
r
                            Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\nat "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Posn -> Name
forall a. Show a => a -> Name
show Posn
pos)
        CMisc Misc
_ Posn
_ -> (Content Posn -> Bool) -> [Name] -> XsdParser (Posn, Element Posn)
posnElementWith Content Posn -> Bool
match [Name]
tags  -- skip comments, PIs, etc.
    }
  where
    formatted :: [Name] -> Name
formatted [Name
t]  = Name
"a <"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
tName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
">"
    formatted [Name]
tgs = Name
"one of"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ (Name -> Name) -> [Name] -> Name
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Name
t->Name
" <"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
tName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
">") [Name]
tgs

-- | Get the next content element, checking that it has the required tag
--   belonging to the XSD namespace.
xsdElement :: Name -> XsdParser (Element Posn)
xsdElement :: Name -> XsdParser (Element Posn)
xsdElement Name
n = ((Posn, Element Posn) -> Element Posn)
-> XsdParser (Posn, Element Posn) -> XsdParser (Element Posn)
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) -> [Name] -> XsdParser (Posn, Element Posn)
posnElementWith (Name -> Content Posn -> Bool
xsdTag Name
n) [Name
"xsd:"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
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 (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) -> [Name] -> XsdParser (Posn, Element Posn)
posnElementWith (Bool -> Content Posn -> Bool
forall a b. a -> b -> a
const Bool
True) [Name
"any element"])

-- | Grab and parse any and all children of the next element.
allChildren :: XsdParser a -> XsdParser a
allChildren :: XsdParser a -> XsdParser a
allChildren XsdParser a
p = do Element Posn
e <- XsdParser (Element Posn)
anyElement
                   (Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Content Posn -> Bool
forall a b. a -> b -> a
const Bool
True) XsdParser a
p Element Posn
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 :: (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) -> XsdParser a
forall t a. ([t] -> Result [t] a) -> Parser t a
P (([Content Posn] -> Result [Content Posn] a) -> XsdParser a)
-> ([Content Posn] -> Result [Content Posn] a) -> XsdParser 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]
_ Name
_)    -> 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] -> Name -> Result [Content Posn] a
forall z a. z -> Name -> Result z a
Failure [Content Posn]
ds (Name
"Too many elements inside <"
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
eName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"> at\n"
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Posn -> Name
forall a. Show a => a -> Name
show (Content Posn -> Posn
forall t. Content t -> t
info Content Posn
d)Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\n\n"
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"Found excess: "
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++[Content Posn] -> Name
forall a. Verbatim a => a -> Name
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 Name
s i
_) | (Char -> Bool) -> Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace Name
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 :: QName -> TextParser a -> Element Posn -> XsdParser a
attribute QName
qn (P Name -> Result Name a
p) (Elem QName
n [Attribute]
as [Content Posn]
_) = ([Content Posn] -> Result [Content Posn] a) -> XsdParser a
forall t a. ([t] -> Result [t] a) -> Parser t a
P (([Content Posn] -> Result [Content Posn] a) -> XsdParser a)
-> ([Content Posn] -> Result [Content Posn] a) -> XsdParser 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] -> Name -> Result [Content Posn] a
forall z a. z -> Name -> Result z a
Failure [Content Posn]
inp (Name -> Result [Content Posn] a)
-> Name -> Result [Content Posn] a
forall a b. (a -> b) -> a -> b
$ Name
"attribute "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
qn
                                  Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
" not present in <"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
nName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
">"
        Just AttValue
atv -> [Content Posn] -> Result Name a -> Result [Content Posn] a
forall t x a. t -> Result x a -> Result t a
tidy [Content Posn]
inp (Result Name a -> Result [Content Posn] a)
-> Result Name a -> Result [Content Posn] a
forall a b. (a -> b) -> a -> b
$
                    case Name -> Result Name a
p (AttValue -> Name
forall a. Show a => a -> Name
show AttValue
atv) of
                      Committed Result Name a
r   -> Result Name a
r
                      Failure Name
z Name
msg -> Name -> Name -> Result Name a
forall z a. z -> Name -> Result z a
Failure Name
z (Name -> Result Name a) -> Name -> Result Name a
forall a b. (a -> b) -> a -> b
$
                                             Name
"Attribute parsing failure: "
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
qnName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"=\""
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++AttValue -> Name
forall a. Show a => a -> Name
show AttValue
atvName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\": "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
msg
                      Success [] a
v  -> Name -> a -> Result Name a
forall z a. z -> a -> Result z a
Success [] a
v
                      Success Name
xs a
_  -> Result Name a -> Result Name a
forall z a. Result z a -> Result z a
Committed (Result Name a -> Result Name a) -> Result Name a -> Result Name a
forall a b. (a -> b) -> a -> b
$
                                       Name -> Name -> Result Name a
forall z a. z -> Name -> Result z a
Failure Name
xs (Name -> Result Name a) -> Name -> Result Name a
forall a b. (a -> b) -> a -> b
$
                                             Name
"Attribute parsing excess text: "
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
qnName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"=\""
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++AttValue -> Name
forall a. Show a => a -> Name
show AttValue
atvName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\":\n  Excess is: "
                                             Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
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 (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 (Name -> Attribute -> Bool
matchNamespace Name
"xmlns") ([Attribute] -> XsdParser [Namespace])
-> [Attribute] -> XsdParser [Namespace]
forall a b. (a -> b) -> a -> b
$ [Attribute]
as
  where
    deQN :: QName -> Name
deQN (QN Namespace
_ Name
n) = Name
n
    mkNamespace :: (QName, a) -> Namespace
mkNamespace (QName
attname,a
attval) = Namespace :: Name -> Name -> Namespace
Namespace { nsPrefix :: Name
nsPrefix = QName -> Name
deQN QName
attname
                                             , nsURI :: Name
nsURI    = a -> Name
forall a. Verbatim a => a -> Name
verbatim a
attval
                                             }

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

-- | Tidy up the parsing context.
tidy :: t -> Result x a -> Result t a
tidy :: 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
_ Name
m) = t -> Name -> Result t a
forall z a. z -> Name -> Result z a
Failure t
inp Name
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 Name -> [Namespace] -> Maybe Name
targetPrefix Maybe Name
Nothing    [Namespace]
_   = Maybe Name
forall a. Maybe a
Nothing
targetPrefix (Just Name
uri) [Namespace]
nss = Namespace -> Name
nsPrefix (Namespace -> Name) -> Maybe Namespace -> Maybe Name
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 ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
uri)(Name -> Bool) -> (Namespace -> Name) -> Namespace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Namespace -> Name
nsURI) [Namespace]
nss

-- | An auxiliary you might expect to find in Data.List
lookupBy :: (a->Bool) -> [a] -> Maybe a
lookupBy :: (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 Name -> [Namespace] -> Name -> Name -> QName
qual Maybe Name
tn [Namespace]
nss Name
pre Name
nm = case Maybe Name -> [Namespace] -> Maybe Name
targetPrefix Maybe Name
tn [Namespace]
nss of
                         Maybe Name
Nothing             -> Namespace -> Name -> QName
QN Namespace
thisNS Name
nm
                         Just Name
p  | Name
pName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
pre    -> Namespace -> Name -> QName
QN Namespace
thisNS Name
nm
                                 | Bool
otherwise -> Name -> QName
N Name
nm
    where thisNS :: Namespace
thisNS = Namespace :: Name -> Name -> Namespace
Namespace{ nsPrefix :: Name
nsPrefix = Name
pre
                            , nsURI :: Name
nsURI = Name -> (Namespace -> Name) -> Maybe Namespace -> Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Name
"" Namespace -> Name
nsURI (Maybe Namespace -> Name) -> Maybe Namespace -> Name
forall a b. (a -> b) -> a -> b
$
                                      (Namespace -> Bool) -> [Namespace] -> Maybe Namespace
forall a. (a -> Bool) -> [a] -> Maybe a
lookupBy ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
pre)(Name -> Bool) -> (Namespace -> Name) -> Namespace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Namespace -> Name
nsPrefix) [Namespace]
nss
                            }

-- Now for the real parsers.

-- | Parse a Schema declaration
schema :: Parser (Content Posn) Schema
schema = do
    Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"schema"
    Parser (Content Posn) Schema -> Parser (Content Posn) Schema
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Schema -> Parser (Content Posn) Schema)
-> Parser (Content Posn) Schema -> Parser (Content Posn) Schema
forall a b. (a -> b) -> a -> b
$ do
        Maybe Name
tn  <- Parser (Content Posn) Name -> Parser (Content Posn) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"targetNamespace") TextParser Name
uri Element Posn
e)
        [Namespace]
nss <- Element Posn -> XsdParser [Namespace]
namespaceAttrs Element Posn
e
        (QForm
 -> QForm
 -> Maybe Final
 -> Maybe Final
 -> Maybe Name
 -> Maybe Name
 -> [Namespace]
 -> [SchemaItem]
 -> Schema)
-> Parser
     (Content Posn)
     (QForm
      -> QForm
      -> Maybe Final
      -> Maybe Final
      -> Maybe Name
      -> Maybe Name
      -> [Namespace]
      -> [SchemaItem]
      -> Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return QForm
-> QForm
-> Maybe Final
-> Maybe Final
-> Maybe Name
-> Maybe Name
-> [Namespace]
-> [SchemaItem]
-> Schema
Schema
          Parser
  (Content Posn)
  (QForm
   -> QForm
   -> Maybe Final
   -> Maybe Final
   -> Maybe Name
   -> Maybe Name
   -> [Namespace]
   -> [SchemaItem]
   -> Schema)
-> Parser (Content Posn) QForm
-> Parser
     (Content Posn)
     (QForm
      -> Maybe Final
      -> Maybe Final
      -> Maybe Name
      -> Maybe Name
      -> [Namespace]
      -> [SchemaItem]
      -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser QForm -> Element Posn -> Parser (Content Posn) QForm
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"elementFormDefault")    TextParser QForm
qform Element Posn
e
                   Parser (Content Posn) QForm
-> Parser (Content Posn) QForm -> Parser (Content Posn) QForm
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` QForm -> Parser (Content Posn) QForm
forall (m :: * -> *) a. Monad m => a -> m a
return QForm
Unqualified)
          Parser
  (Content Posn)
  (QForm
   -> Maybe Final
   -> Maybe Final
   -> Maybe Name
   -> Maybe Name
   -> [Namespace]
   -> [SchemaItem]
   -> Schema)
-> Parser (Content Posn) QForm
-> Parser
     (Content Posn)
     (Maybe Final
      -> Maybe Final
      -> Maybe Name
      -> Maybe Name
      -> [Namespace]
      -> [SchemaItem]
      -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser QForm -> Element Posn -> Parser (Content Posn) QForm
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"attributeFormDefault")  TextParser QForm
qform Element Posn
e
                   Parser (Content Posn) QForm
-> Parser (Content Posn) QForm -> Parser (Content Posn) QForm
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` QForm -> Parser (Content Posn) QForm
forall (m :: * -> *) a. Monad m => a -> m a
return QForm
Unqualified)
          Parser
  (Content Posn)
  (Maybe Final
   -> Maybe Final
   -> Maybe Name
   -> Maybe Name
   -> [Namespace]
   -> [SchemaItem]
   -> Schema)
-> Parser (Content Posn) (Maybe Final)
-> Parser
     (Content Posn)
     (Maybe Final
      -> Maybe Name
      -> Maybe Name
      -> [Namespace]
      -> [SchemaItem]
      -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"finalDefault") TextParser Final
final Element Posn
e)
          Parser
  (Content Posn)
  (Maybe Final
   -> Maybe Name
   -> Maybe Name
   -> [Namespace]
   -> [SchemaItem]
   -> Schema)
-> Parser (Content Posn) (Maybe Final)
-> Parser
     (Content Posn)
     (Maybe Name -> Maybe Name -> [Namespace] -> [SchemaItem] -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"blockDefault") TextParser Final
block Element Posn
e)
          Parser
  (Content Posn)
  (Maybe Name -> Maybe Name -> [Namespace] -> [SchemaItem] -> Schema)
-> Parser (Content Posn) (Maybe Name)
-> Parser
     (Content Posn)
     (Maybe Name -> [Namespace] -> [SchemaItem] -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Maybe Name -> Parser (Content Posn) (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
tn
          Parser
  (Content Posn)
  (Maybe Name -> [Namespace] -> [SchemaItem] -> Schema)
-> Parser (Content Posn) (Maybe Name)
-> Parser (Content Posn) ([Namespace] -> [SchemaItem] -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Name -> Parser (Content Posn) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"version")       TextParser Name
string Element Posn
e)
          Parser (Content Posn) ([Namespace] -> [SchemaItem] -> Schema)
-> XsdParser [Namespace]
-> Parser (Content Posn) ([SchemaItem] -> Schema)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` [Namespace] -> XsdParser [Namespace]
forall (m :: * -> *) a. Monad m => a -> m a
return [Namespace]
nss
          Parser (Content Posn) ([SchemaItem] -> Schema)
-> Parser (Content Posn) [SchemaItem]
-> Parser (Content Posn) Schema
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [SchemaItem]
-> Element Posn
-> Parser (Content Posn) [SchemaItem]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Content Posn -> Bool
forall a b. a -> b -> a
const Bool
True) (Parser (Content Posn) SchemaItem
-> Parser (Content Posn) [SchemaItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
schemaItem (Maybe Name -> [Namespace] -> Name -> Name -> QName
qual Maybe Name
tn [Namespace]
nss))) Element Posn
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 (m :: * -> *) a. Monad m => a -> m a
return (Name -> Annotation
NoAnnotation Name
"missing")

-- | Parse a definitely-occurring <xsd:annotation> element.
definiteAnnotation :: XsdParser Annotation
definiteAnnotation :: XsdParser Annotation
definiteAnnotation = do
    Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"annotation"
    ( Name -> Annotation
Documentation (Name -> Annotation)
-> Parser (Content Posn) Name -> XsdParser Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content Posn -> Bool)
-> Parser (Content Posn) Name
-> Element Posn
-> Parser (Content Posn) Name
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"documentation")
                                        (Parser (Content Posn) Name -> Parser (Content Posn) Name
forall a. XsdParser a -> XsdParser a
allChildren Parser (Content Posn) Name
text)  Element Posn
e)
      XsdParser Annotation
-> XsdParser Annotation -> XsdParser Annotation
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
      (Name -> Annotation
AppInfo (Name -> Annotation)
-> Parser (Content Posn) Name -> XsdParser Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content Posn -> Bool)
-> Parser (Content Posn) Name
-> Element Posn
-> Parser (Content Posn) Name
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"documentation")
                                        (Parser (Content Posn) Name -> Parser (Content Posn) Name
forall a. XsdParser a -> XsdParser a
allChildren Parser (Content Posn) Name
text)  Element Posn
e)
      XsdParser Annotation
-> XsdParser Annotation -> XsdParser Annotation
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
      Annotation -> XsdParser Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Annotation
NoAnnotation Name
"failed to parse")

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

-- | Parse a Final or Block attribute.
final :: TextParser Final
final :: TextParser Final
final = do
    Name
w <- TextParser Name
word
    case Name
w of
        Name
"restriction" -> Final -> TextParser Final
forall (m :: * -> *) a. Monad m => a -> m a
return Final
NoRestriction
        Name
"extension"   -> Final -> TextParser Final
forall (m :: * -> *) a. Monad m => a -> m a
return Final
NoExtension
        Name
"#all"        -> Final -> TextParser Final
forall (m :: * -> *) a. Monad m => a -> m a
return Final
AllFinal
        Name
_             -> Name -> TextParser Final
forall (p :: * -> *) a. PolyParse p => Name -> p a
failBad (Name -> TextParser Final) -> Name -> TextParser Final
forall a b. (a -> b) -> a -> b
$ Name
"Expected \"restriction\" or \"extension\""
                                   Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
" 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 :: (Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
schemaItem Name -> Name -> QName
qual = [(Name, Parser (Content Posn) SchemaItem)]
-> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a. Commitment p => [(Name, p a)] -> p a
oneOf'
       [ (Name
"xsd:include",        Parser (Content Posn) SchemaItem
include)
       , (Name
"xsd:import",         Parser (Content Posn) SchemaItem
import_)
       , (Name
"xsd:redefine",       (Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
redefine Name -> Name -> QName
qual)
       , (Name
"xsd:annotation",     (Annotation -> SchemaItem)
-> XsdParser Annotation -> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Annotation -> SchemaItem
Annotation     XsdParser Annotation
definiteAnnotation)
         --
       , (Name
"xsd:simpleType",     (SimpleType -> SchemaItem)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> SchemaItem
Simple           ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
qual))
       , (Name
"xsd:complexType",    (ComplexType -> SchemaItem)
-> Parser (Content Posn) ComplexType
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComplexType -> SchemaItem
Complex          ((Name -> Name -> QName) -> Parser (Content Posn) ComplexType
complexType Name -> Name -> QName
qual))
       , (Name
"xsd:element",        (ElementDecl -> SchemaItem)
-> Parser (Content Posn) ElementDecl
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementDecl -> SchemaItem
SchemaElement    ((Name -> Name -> QName) -> Parser (Content Posn) ElementDecl
elementDecl Name -> Name -> QName
qual))
       , (Name
"xsd:attribute",      (AttributeDecl -> SchemaItem)
-> Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttributeDecl -> SchemaItem
SchemaAttribute  ((Name -> Name -> QName) -> Parser (Content Posn) AttributeDecl
attributeDecl Name -> Name -> QName
qual))
       , (Name
"xsd:attributeGroup", (AttrGroup -> SchemaItem)
-> Parser (Content Posn) AttrGroup
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttrGroup -> SchemaItem
AttributeGroup   ((Name -> Name -> QName) -> Parser (Content Posn) AttrGroup
attributeGroup Name -> Name -> QName
qual))
       , (Name
"xsd:group",          (Group -> SchemaItem)
-> Parser (Content Posn) Group -> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> SchemaItem
SchemaGroup      ((Name -> Name -> QName) -> Parser (Content Posn) Group
group_ Name -> Name -> QName
qual))
   --  , ("xsd:notation",       notation)
-- sigh
       , (Name
"xs:include",        Parser (Content Posn) SchemaItem
include)
       , (Name
"xs:import",         Parser (Content Posn) SchemaItem
import_)
       , (Name
"xs:redefine",       (Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
redefine Name -> Name -> QName
qual)
       , (Name
"xs:annotation",     (Annotation -> SchemaItem)
-> XsdParser Annotation -> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Annotation -> SchemaItem
Annotation     XsdParser Annotation
definiteAnnotation)
         --
       , (Name
"xs:simpleType",     (SimpleType -> SchemaItem)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> SchemaItem
Simple           ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
qual))
       , (Name
"xs:complexType",    (ComplexType -> SchemaItem)
-> Parser (Content Posn) ComplexType
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComplexType -> SchemaItem
Complex          ((Name -> Name -> QName) -> Parser (Content Posn) ComplexType
complexType Name -> Name -> QName
qual))
       , (Name
"xs:element",        (ElementDecl -> SchemaItem)
-> Parser (Content Posn) ElementDecl
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementDecl -> SchemaItem
SchemaElement    ((Name -> Name -> QName) -> Parser (Content Posn) ElementDecl
elementDecl Name -> Name -> QName
qual))
       , (Name
"xs:attribute",      (AttributeDecl -> SchemaItem)
-> Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttributeDecl -> SchemaItem
SchemaAttribute  ((Name -> Name -> QName) -> Parser (Content Posn) AttributeDecl
attributeDecl Name -> Name -> QName
qual))
       , (Name
"xs:attributeGroup", (AttrGroup -> SchemaItem)
-> Parser (Content Posn) AttrGroup
-> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttrGroup -> SchemaItem
AttributeGroup   ((Name -> Name -> QName) -> Parser (Content Posn) AttrGroup
attributeGroup Name -> Name -> QName
qual))
       , (Name
"xs:group",          (Group -> SchemaItem)
-> Parser (Content Posn) Group -> Parser (Content Posn) SchemaItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> SchemaItem
SchemaGroup      ((Name -> Name -> QName) -> Parser (Content Posn) Group
group_ Name -> Name -> QName
qual))
   --  , ("xs:notation",       notation)
       ]

-- | Parse an <xsd:include>.
include :: XsdParser SchemaItem
include :: Parser (Content Posn) SchemaItem
include = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"include"
             Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SchemaItem
 -> Parser (Content Posn) SchemaItem)
-> Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall a b. (a -> b) -> a -> b
$ (Name -> Annotation -> SchemaItem)
-> Parser (Content Posn) (Name -> Annotation -> SchemaItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Name -> Annotation -> SchemaItem
Include
                      Parser (Content Posn) (Name -> Annotation -> SchemaItem)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Annotation -> SchemaItem)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"schemaLocation") TextParser Name
uri Element Posn
e
                      Parser (Content Posn) (Annotation -> SchemaItem)
-> XsdParser Annotation -> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e

-- | Parse an <xsd:import>.
import_ :: XsdParser SchemaItem
import_ :: Parser (Content Posn) SchemaItem
import_ = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"import"
             Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SchemaItem
 -> Parser (Content Posn) SchemaItem)
-> Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall a b. (a -> b) -> a -> b
$ (Name -> Name -> Annotation -> SchemaItem)
-> Parser (Content Posn) (Name -> Name -> Annotation -> SchemaItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Name -> Name -> Annotation -> SchemaItem
Import
                      Parser (Content Posn) (Name -> Name -> Annotation -> SchemaItem)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Name -> Annotation -> SchemaItem)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"namespace")      TextParser Name
uri Element Posn
e
                      Parser (Content Posn) (Name -> Annotation -> SchemaItem)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Annotation -> SchemaItem)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"schemaLocation") TextParser Name
uri Element Posn
e
                      Parser (Content Posn) (Annotation -> SchemaItem)
-> XsdParser Annotation -> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e

-- | Parse a <xsd:redefine>.
redefine :: (String->String->QName) -> XsdParser SchemaItem
redefine :: (Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
redefine Name -> Name -> QName
q = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"redefine"
                Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SchemaItem
 -> Parser (Content Posn) SchemaItem)
-> Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall a b. (a -> b) -> a -> b
$ (Name -> [SchemaItem] -> SchemaItem)
-> Parser (Content Posn) (Name -> [SchemaItem] -> SchemaItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Name -> [SchemaItem] -> SchemaItem
Redefine
                     Parser (Content Posn) (Name -> [SchemaItem] -> SchemaItem)
-> Parser (Content Posn) Name
-> Parser (Content Posn) ([SchemaItem] -> SchemaItem)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"schemaLocation") TextParser Name
uri Element Posn
e
                     Parser (Content Posn) ([SchemaItem] -> SchemaItem)
-> Parser (Content Posn) [SchemaItem]
-> Parser (Content Posn) SchemaItem
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [SchemaItem]
-> Element Posn
-> Parser (Content Posn) [SchemaItem]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Content Posn -> Bool
forall a b. a -> b -> a
const Bool
True) (Parser (Content Posn) SchemaItem
-> Parser (Content Posn) [SchemaItem]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) SchemaItem
schemaItem Name -> Name -> QName
q)) Element Posn
e

-- | Parse a <xsd:simpleType> decl.
simpleType :: (String->String->QName) -> XsdParser SimpleType
simpleType :: (Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
q = do
    Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"simpleType"
    Maybe Name
n <- Parser (Content Posn) Name -> Parser (Content Posn) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
name Element Posn
e)
    Maybe Final
f <- Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"final") TextParser Final
final Element Posn
e)
    Annotation
a <- (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
    Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SimpleType
 -> Parser (Content Posn) SimpleType)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a b. (a -> b) -> a -> b
$ (Content Posn -> Bool)
-> Parser (Content Posn) SimpleType
-> Element Posn
-> Parser (Content Posn) SimpleType
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not (Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Content Posn -> Bool
xsdTag Name
"annotation") (Maybe Name
-> Maybe Final -> Annotation -> Parser (Content Posn) SimpleType
simpleItem Maybe Name
n Maybe Final
f Annotation
a) Element Posn
e
  where
    simpleItem :: Maybe Name
-> Maybe Final -> Annotation -> Parser (Content Posn) SimpleType
simpleItem Maybe Name
n Maybe Final
f Annotation
a =
        do Element Posn
e  <- Name -> XsdParser (Element Posn)
xsdElement Name
"restriction"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SimpleType
 -> Parser (Content Posn) SimpleType)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a b. (a -> b) -> a -> b
$ do
             Annotation
a1 <- (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
             Maybe QName
b  <- 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 (Name -> QName
N Name
"base") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e)
             Restriction
r  <- (Content Posn -> Bool)
-> XsdParser Restriction -> Element Posn -> XsdParser Restriction
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not (Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Content Posn -> Bool
xsdTag Name
"annotation")
                                (Annotation -> Maybe QName -> XsdParser Restriction
restrictType Annotation
a1 Maybe QName
b XsdParser Restriction
-> XsdParser Restriction -> XsdParser Restriction
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Annotation -> Maybe QName -> XsdParser Restriction
restriction1 Annotation
a1 Maybe QName
b) Element Posn
e
             SimpleType -> Parser (Content Posn) SimpleType
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe Name -> Maybe Final -> Restriction -> SimpleType
Restricted Annotation
a Maybe Name
n Maybe Final
f Restriction
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 Element Posn
e  <- Name -> XsdParser (Element Posn)
xsdElement Name
"list"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SimpleType
 -> Parser (Content Posn) SimpleType)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a b. (a -> b) -> a -> b
$ do
             Annotation
a1 <- (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
             Either SimpleType QName
t  <- QName
-> TextParser (Either SimpleType QName)
-> Element Posn
-> XsdParser (Either SimpleType QName)
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"itemType") ((QName -> Either SimpleType QName)
-> TextParser QName -> TextParser (Either SimpleType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either SimpleType QName
forall a b. b -> Either a b
Right ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q)) Element Posn
e
                     XsdParser (Either SimpleType QName)
-> XsdParser (Either SimpleType QName)
-> XsdParser (Either SimpleType QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                   (Content Posn -> Bool)
-> XsdParser (Either SimpleType QName)
-> Element Posn
-> XsdParser (Either SimpleType QName)
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"simpleType")
                                ((SimpleType -> Either SimpleType QName)
-> Parser (Content Posn) SimpleType
-> XsdParser (Either SimpleType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> Either SimpleType QName
forall a b. a -> Either a b
Left ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
q)) Element Posn
e
                     XsdParser (Either SimpleType QName)
-> (Name -> Name) -> XsdParser (Either SimpleType QName)
forall (p :: * -> *) a.
Commitment p =>
p a -> (Name -> Name) -> p a
`adjustErr`
                   ((Name
"Expected attribute 'itemType' or element <simpleType>\n"
                    Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"  inside <list> decl.\n")Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++)
             SimpleType -> Parser (Content Posn) SimpleType
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe Name
-> Maybe Final
-> Either SimpleType QName
-> SimpleType
ListOf (Annotation
aAnnotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend`Annotation
a1) Maybe Name
n Maybe Final
f Either SimpleType QName
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 Element Posn
e  <- Name -> XsdParser (Element Posn)
xsdElement Name
"union"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) SimpleType
 -> Parser (Content Posn) SimpleType)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a b. (a -> b) -> a -> b
$ do
             Annotation
a1 <- (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
             [SimpleType]
ts <- (Content Posn -> Bool)
-> XsdParser [SimpleType] -> Element Posn -> XsdParser [SimpleType]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"simpleType") (Parser (Content Posn) SimpleType -> XsdParser [SimpleType]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
q)) Element Posn
e
             [QName]
ms <- QName -> TextParser [QName] -> Element Posn -> XsdParser [QName]
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"memberTypes") (TextParser QName -> TextParser [QName]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q)) Element Posn
e
                   XsdParser [QName] -> XsdParser [QName] -> XsdParser [QName]
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` [QName] -> XsdParser [QName]
forall (m :: * -> *) a. Monad m => a -> m a
return []
             SimpleType -> Parser (Content Posn) SimpleType
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe Name
-> Maybe Final
-> [SimpleType]
-> [QName]
-> SimpleType
UnionOf (Annotation
aAnnotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend`Annotation
a1) Maybe Name
n Maybe Final
f [SimpleType]
ts [QName]
ms)
        Parser (Content Posn) SimpleType
-> (Name -> Name) -> Parser (Content Posn) SimpleType
forall (p :: * -> *) a.
Commitment p =>
p a -> (Name -> Name) -> p a
`adjustErr`
        (Name
"xsd:simpleType does not contain a restriction, list, or union\n"Name -> Name -> Name
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 (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 (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` (Name -> Name -> QName) -> Parser (Content Posn) Particle
particle Name -> Name -> 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 (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 ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> 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 (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 (Name -> Parser (Content Posn) Facet
forall (m :: * -> *) a. MonadFail m => Name -> m a
fail Name
"Could not recognise simpleType Facet")
               ((Name -> FacetType -> Parser (Content Posn) Facet)
-> [Name] -> [FacetType] -> [Parser (Content Posn) Facet]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> FacetType -> Parser (Content Posn) Facet
facet [Name
"minInclusive",Name
"minExclusive",Name
"maxInclusive"
                              ,Name
"maxExclusive",Name
"totalDigits",Name
"fractionDigits"
                              ,Name
"length",Name
"minLength",Name
"maxLength"
                              ,Name
"enumeration",Name
"whiteSpace",Name
"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 :: Name -> FacetType -> Parser (Content Posn) Facet
facet Name
s FacetType
t = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
s
               Name
v <- QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"value") TextParser Name
string Element Posn
e
               Bool
f <- QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"fixed") TextParser Bool
bool Element Posn
e
                    XsdParser Bool -> XsdParser Bool -> XsdParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Bool -> XsdParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- XXX check this
               Annotation
a <- (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Content Posn -> Bool
forall a b. a -> b -> a
const Bool
True) XsdParser Annotation
annotation Element Posn
e
               Facet -> Parser (Content Posn) Facet
forall (m :: * -> *) a. Monad m => a -> m a
return (FacetType -> Annotation -> Name -> Bool -> Facet
Facet FacetType
t Annotation
a Name
v Bool
f)

-- | Parse a <xsd:complexType> decl.
complexType :: (String->String->QName) -> XsdParser ComplexType
complexType :: (Name -> Name -> QName) -> Parser (Content Posn) ComplexType
complexType Name -> Name -> QName
q =
    do Element Posn
e  <- Name -> XsdParser (Element Posn)
xsdElement Name
"complexType"
       Parser (Content Posn) ComplexType
-> Parser (Content Posn) ComplexType
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) ComplexType
 -> Parser (Content Posn) ComplexType)
-> Parser (Content Posn) ComplexType
-> Parser (Content Posn) ComplexType
forall a b. (a -> b) -> a -> b
$ (Annotation
 -> Maybe Name
 -> Bool
 -> Maybe Final
 -> Maybe Final
 -> Bool
 -> ComplexItem
 -> ComplexType)
-> Parser
     (Content Posn)
     (Annotation
      -> Maybe Name
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> Bool
      -> ComplexItem
      -> ComplexType)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Maybe Name
-> Bool
-> Maybe Final
-> Maybe Final
-> Bool
-> ComplexItem
-> ComplexType
ComplexType
           Parser
  (Content Posn)
  (Annotation
   -> Maybe Name
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> Bool
   -> ComplexItem
   -> ComplexType)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Maybe Name
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> Bool
      -> ComplexItem
      -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Maybe Name
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> Bool
   -> ComplexItem
   -> ComplexType)
-> Parser (Content Posn) (Maybe Name)
-> Parser
     (Content Posn)
     (Bool
      -> Maybe Final
      -> Maybe Final
      -> Bool
      -> ComplexItem
      -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Name -> Parser (Content Posn) (Maybe Name)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e)
           Parser
  (Content Posn)
  (Bool
   -> Maybe Final
   -> Maybe Final
   -> Bool
   -> ComplexItem
   -> ComplexType)
-> XsdParser Bool
-> Parser
     (Content Posn)
     (Maybe Final -> Maybe Final -> Bool -> ComplexItem -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"abstract") TextParser Bool
bool Element Posn
e XsdParser Bool -> XsdParser Bool -> XsdParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Bool -> XsdParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           Parser
  (Content Posn)
  (Maybe Final -> Maybe Final -> Bool -> ComplexItem -> ComplexType)
-> Parser (Content Posn) (Maybe Final)
-> Parser
     (Content Posn) (Maybe Final -> Bool -> ComplexItem -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"final") TextParser Final
final Element Posn
e)
           Parser
  (Content Posn) (Maybe Final -> Bool -> ComplexItem -> ComplexType)
-> Parser (Content Posn) (Maybe Final)
-> Parser (Content Posn) (Bool -> ComplexItem -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"block") TextParser Final
block Element Posn
e)
           Parser (Content Posn) (Bool -> ComplexItem -> ComplexType)
-> XsdParser Bool
-> Parser (Content Posn) (ComplexItem -> ComplexType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"mixed") TextParser Bool
bool Element Posn
e XsdParser Bool -> XsdParser Bool -> XsdParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Bool -> XsdParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           Parser (Content Posn) (ComplexItem -> ComplexType)
-> Parser (Content Posn) ComplexItem
-> Parser (Content Posn) ComplexType
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) ComplexItem
-> Element Posn
-> Parser (Content Posn) ComplexItem
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not (Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Content Posn -> Bool
xsdTag Name
"annotation") ((Name -> Name -> QName) -> Parser (Content Posn) ComplexItem
complexItem Name -> Name -> QName
q) Element Posn
e

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

-- | Parse a particle decl.
particle :: (String->String->QName) -> XsdParser Particle
particle :: (Name -> Name -> QName) -> Parser (Content Posn) Particle
particle Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChoiceOrSeq -> Either ChoiceOrSeq Group
forall a b. a -> Either a b
Left ((Name -> Name -> QName) -> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> Either ChoiceOrSeq Group
forall a b. b -> Either a b
Right ((Name -> Name -> QName) -> Parser (Content Posn) Group
group_ Name -> Name -> QName
q))

-- | Parse a particle decl with optional attributes.
particleAttrs :: (String->String->QName) -> XsdParser ParticleAttrs
particleAttrs :: (Name -> Name -> QName) -> Parser (Content Posn) ParticleAttrs
particleAttrs Name -> Name -> QName
q = (Particle
 -> [Either AttributeDecl AttrGroup]
 -> Maybe AnyAttr
 -> ParticleAttrs)
-> Parser
     (Content Posn)
     (Particle
      -> [Either AttributeDecl AttrGroup]
      -> Maybe AnyAttr
      -> ParticleAttrs)
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` (Name -> Name -> QName) -> Parser (Content Posn) Particle
particle Name -> Name -> 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 (f :: * -> *) a. Alternative f => f a -> f [a]
many ((AttributeDecl -> Either AttributeDecl AttrGroup)
-> Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) (Either AttributeDecl AttrGroup)
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 ((Name -> Name -> QName) -> Parser (Content Posn) AttributeDecl
attributeDecl Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttrGroup -> Either AttributeDecl AttrGroup
forall a b. b -> Either a b
Right ((Name -> Name -> QName) -> Parser (Content Posn) AttrGroup
attributeGroup Name -> Name -> 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 :: (Name -> Name -> QName) -> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq Name -> Name -> QName
q =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"all"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) ChoiceOrSeq
 -> Parser (Content Posn) ChoiceOrSeq)
-> Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a b. (a -> b) -> a -> b
$ (Annotation -> [ElementDecl] -> ChoiceOrSeq)
-> Parser
     (Content Posn) (Annotation -> [ElementDecl] -> ChoiceOrSeq)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> [ElementDecl] -> ChoiceOrSeq
All
           Parser (Content Posn) (Annotation -> [ElementDecl] -> ChoiceOrSeq)
-> XsdParser Annotation
-> Parser (Content Posn) ([ElementDecl] -> ChoiceOrSeq)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) ([ElementDecl] -> ChoiceOrSeq)
-> Parser (Content Posn) [ElementDecl]
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [ElementDecl]
-> Element Posn
-> Parser (Content Posn) [ElementDecl]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not(Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Name -> Content Posn -> Bool
xsdTag Name
"annotation")
                                (Parser (Content Posn) ElementDecl
-> Parser (Content Posn) [ElementDecl]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) ElementDecl
elementDecl Name -> Name -> QName
q)) Element Posn
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 Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"choice"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) ChoiceOrSeq
 -> Parser (Content Posn) ChoiceOrSeq)
-> Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a b. (a -> b) -> a -> b
$ (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> Parser
     (Content Posn)
     (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq
Choice
           Parser
  (Content Posn)
  (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> XsdParser Annotation
-> Parser (Content Posn) (Occurs -> [ElementEtc] -> ChoiceOrSeq)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> Parser (Content Posn) Occurs
-> Parser (Content Posn) ([ElementEtc] -> ChoiceOrSeq)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Element Posn -> Parser (Content Posn) Occurs
occurs Element Posn
e
           Parser (Content Posn) ([ElementEtc] -> ChoiceOrSeq)
-> Parser (Content Posn) [ElementEtc]
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [ElementEtc]
-> Element Posn
-> Parser (Content Posn) [ElementEtc]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not(Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Name -> Content Posn -> Bool
xsdTag Name
"annotation")
                                (Parser (Content Posn) ElementEtc
-> Parser (Content Posn) [ElementEtc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) ElementEtc
elementEtc Name -> Name -> QName
q)) Element Posn
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 Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"sequence"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) ChoiceOrSeq
 -> Parser (Content Posn) ChoiceOrSeq)
-> Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a b. (a -> b) -> a -> b
$ (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> Parser
     (Content Posn)
     (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq
Sequence
           Parser
  (Content Posn)
  (Annotation -> Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> XsdParser Annotation
-> Parser (Content Posn) (Occurs -> [ElementEtc] -> ChoiceOrSeq)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Occurs -> [ElementEtc] -> ChoiceOrSeq)
-> Parser (Content Posn) Occurs
-> Parser (Content Posn) ([ElementEtc] -> ChoiceOrSeq)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Element Posn -> Parser (Content Posn) Occurs
occurs Element Posn
e
           Parser (Content Posn) ([ElementEtc] -> ChoiceOrSeq)
-> Parser (Content Posn) [ElementEtc]
-> Parser (Content Posn) ChoiceOrSeq
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [ElementEtc]
-> Element Posn
-> Parser (Content Posn) [ElementEtc]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not(Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Name -> Content Posn -> Bool
xsdTag Name
"annotation")
                                (Parser (Content Posn) ElementEtc
-> Parser (Content Posn) [ElementEtc]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) ElementEtc
elementEtc Name -> Name -> QName
q)) Element Posn
e

-- | Parse a <xsd:group> decl.
group_ :: (String->String->QName) -> XsdParser Group
group_ :: (Name -> Name -> QName) -> Parser (Content Posn) Group
group_ Name -> Name -> QName
q = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"group"
              Parser (Content Posn) Group -> Parser (Content Posn) Group
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Group -> Parser (Content Posn) Group)
-> Parser (Content Posn) Group -> Parser (Content Posn) Group
forall a b. (a -> b) -> a -> b
$ (Annotation
 -> Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group)
-> Parser
     (Content Posn)
     (Annotation
      -> Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group
Group
                Parser
  (Content Posn)
  (Annotation
   -> Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
                Parser
  (Content Posn)
  (Either Name QName -> Occurs -> Maybe ChoiceOrSeq -> Group)
-> Parser (Content Posn) (Either Name QName)
-> Parser (Content Posn) (Occurs -> Maybe ChoiceOrSeq -> Group)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` ((Name -> Either Name QName)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Either Name QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name QName
forall a b. a -> Either a b
Left (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e)
                         Parser (Content Posn) (Either Name QName)
-> Parser (Content Posn) (Either Name QName)
-> Parser (Content Posn) (Either Name QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                         (QName -> Either Name QName)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Either Name QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either Name QName
forall a b. b -> Either a b
Right (QName
-> TextParser QName -> Element Posn -> Parser (Content Posn) QName
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"ref") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e))
                Parser (Content Posn) (Occurs -> Maybe ChoiceOrSeq -> Group)
-> Parser (Content Posn) Occurs
-> Parser (Content Posn) (Maybe ChoiceOrSeq -> Group)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Element Posn -> Parser (Content Posn) Occurs
occurs Element Posn
e
                Parser (Content Posn) (Maybe ChoiceOrSeq -> Group)
-> Parser (Content Posn) (Maybe ChoiceOrSeq)
-> Parser (Content Posn) Group
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) (Maybe ChoiceOrSeq)
-> Element Posn
-> Parser (Content Posn) (Maybe ChoiceOrSeq)
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not(Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Name -> Content Posn -> Bool
xsdTag Name
"annotation")
                                     (Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) (Maybe ChoiceOrSeq)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Name -> Name -> QName) -> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq Name -> Name -> QName
q)) Element Posn
e

-- | Parse an <xsd:element>, <xsd:group>, <xsd:all>, <xsd:choice>,
--   <xsd:sequence> or <xsd:any>.
elementEtc :: (String->String->QName) -> XsdParser ElementEtc
elementEtc :: (Name -> Name -> QName) -> Parser (Content Posn) ElementEtc
elementEtc Name -> Name -> QName
q = (ElementDecl -> ElementEtc)
-> Parser (Content Posn) ElementDecl
-> Parser (Content Posn) ElementEtc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementDecl -> ElementEtc
HasElement ((Name -> Name -> QName) -> Parser (Content Posn) ElementDecl
elementDecl Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> ElementEtc
HasGroup ((Name -> Name -> QName) -> Parser (Content Posn) Group
group_ Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChoiceOrSeq -> ElementEtc
HasCS ((Name -> Name -> QName) -> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq Name -> Name -> 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 (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 Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"any"
          Parser (Content Posn) Any -> Parser (Content Posn) Any
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Any -> Parser (Content Posn) Any)
-> Parser (Content Posn) Any -> Parser (Content Posn) Any
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> ProcessContents -> Occurs -> Any)
-> Parser
     (Content Posn)
     (Annotation -> Name -> ProcessContents -> Occurs -> Any)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> ProcessContents -> Occurs -> Any
Any
              Parser
  (Content Posn)
  (Annotation -> Name -> ProcessContents -> Occurs -> Any)
-> XsdParser Annotation
-> Parser (Content Posn) (Name -> ProcessContents -> Occurs -> Any)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
              Parser (Content Posn) (Name -> ProcessContents -> Occurs -> Any)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (ProcessContents -> Occurs -> Any)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"namespace") TextParser Name
uri Element Posn
e
                       Parser (Content Posn) Name
-> Parser (Content Posn) Name -> Parser (Content Posn) Name
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Name -> Parser (Content Posn) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
"##any")
              Parser (Content Posn) (ProcessContents -> Occurs -> Any)
-> Parser (Content Posn) ProcessContents
-> Parser (Content Posn) (Occurs -> Any)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser ProcessContents
-> Element Posn
-> Parser (Content Posn) ProcessContents
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"processContents") TextParser ProcessContents
processContents Element Posn
e
                       Parser (Content Posn) ProcessContents
-> Parser (Content Posn) ProcessContents
-> Parser (Content Posn) ProcessContents
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` ProcessContents -> Parser (Content Posn) ProcessContents
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContents
Strict)
              Parser (Content Posn) (Occurs -> Any)
-> Parser (Content Posn) Occurs -> Parser (Content Posn) Any
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Element Posn -> Parser (Content Posn) Occurs
occurs Element Posn
e

-- | Parse an <xsd:anyAttribute>.
anyAttr :: XsdParser AnyAttr
anyAttr :: Parser (Content Posn) AnyAttr
anyAttr = do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"anyAttribute"
             Parser (Content Posn) AnyAttr -> Parser (Content Posn) AnyAttr
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) AnyAttr -> Parser (Content Posn) AnyAttr)
-> Parser (Content Posn) AnyAttr -> Parser (Content Posn) AnyAttr
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> ProcessContents -> AnyAttr)
-> Parser
     (Content Posn) (Annotation -> Name -> ProcessContents -> AnyAttr)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> ProcessContents -> AnyAttr
AnyAttr
                 Parser
  (Content Posn) (Annotation -> Name -> ProcessContents -> AnyAttr)
-> XsdParser Annotation
-> Parser (Content Posn) (Name -> ProcessContents -> AnyAttr)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
                 Parser (Content Posn) (Name -> ProcessContents -> AnyAttr)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (ProcessContents -> AnyAttr)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"namespace") TextParser Name
uri Element Posn
e
                          Parser (Content Posn) Name
-> Parser (Content Posn) Name -> Parser (Content Posn) Name
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Name -> Parser (Content Posn) Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
"##any")
                 Parser (Content Posn) (ProcessContents -> AnyAttr)
-> Parser (Content Posn) ProcessContents
-> Parser (Content Posn) AnyAttr
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser ProcessContents
-> Element Posn
-> Parser (Content Posn) ProcessContents
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"processContents") TextParser ProcessContents
processContents Element Posn
e
                          Parser (Content Posn) ProcessContents
-> Parser (Content Posn) ProcessContents
-> Parser (Content Posn) ProcessContents
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` ProcessContents -> Parser (Content Posn) ProcessContents
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContents
Strict)

-- | Parse an <xsd:attributegroup>.
attributeGroup :: (String->String->QName) -> XsdParser AttrGroup
attributeGroup :: (Name -> Name -> QName) -> Parser (Content Posn) AttrGroup
attributeGroup Name -> Name -> QName
q =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"attributeGroup"
       Parser (Content Posn) AttrGroup -> Parser (Content Posn) AttrGroup
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) AttrGroup
 -> Parser (Content Posn) AttrGroup)
-> Parser (Content Posn) AttrGroup
-> Parser (Content Posn) AttrGroup
forall a b. (a -> b) -> a -> b
$ (Annotation
 -> Either Name QName
 -> [Either AttributeDecl AttrGroup]
 -> AttrGroup)
-> Parser
     (Content Posn)
     (Annotation
      -> Either Name QName
      -> [Either AttributeDecl AttrGroup]
      -> AttrGroup)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either Name QName
-> [Either AttributeDecl AttrGroup]
-> AttrGroup
AttrGroup
           Parser
  (Content Posn)
  (Annotation
   -> Either Name QName
   -> [Either AttributeDecl AttrGroup]
   -> AttrGroup)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either Name QName
      -> [Either AttributeDecl AttrGroup] -> AttrGroup)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Either Name QName
   -> [Either AttributeDecl AttrGroup] -> AttrGroup)
-> Parser (Content Posn) (Either Name QName)
-> Parser
     (Content Posn) ([Either AttributeDecl AttrGroup] -> AttrGroup)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` ((Name -> Either Name QName)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Either Name QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name QName
forall a b. a -> Either a b
Left (QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e)
                    Parser (Content Posn) (Either Name QName)
-> Parser (Content Posn) (Either Name QName)
-> Parser (Content Posn) (Either Name QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                    (QName -> Either Name QName)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Either Name QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either Name QName
forall a b. b -> Either a b
Right (QName
-> TextParser QName -> Element Posn -> Parser (Content Posn) QName
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"ref") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e))
           Parser
  (Content Posn) ([Either AttributeDecl AttrGroup] -> AttrGroup)
-> Parser (Content Posn) [Either AttributeDecl AttrGroup]
-> Parser (Content Posn) AttrGroup
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [Either AttributeDecl AttrGroup]
-> Element Posn
-> Parser (Content Posn) [Either AttributeDecl AttrGroup]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Bool -> Bool
not(Bool -> Bool) -> (Content Posn -> Bool) -> Content Posn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Name -> Content Posn -> Bool
xsdTag Name
"annotation") (Parser (Content Posn) (Either AttributeDecl AttrGroup)
-> Parser (Content Posn) [Either AttributeDecl AttrGroup]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Content Posn) (Either AttributeDecl AttrGroup)
stuff) Element Posn
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttributeDecl -> Either AttributeDecl AttrGroup
forall a b. a -> Either a b
Left ((Name -> Name -> QName) -> Parser (Content Posn) AttributeDecl
attributeDecl Name -> Name -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AttrGroup -> Either AttributeDecl AttrGroup
forall a b. b -> Either a b
Right ((Name -> Name -> QName) -> Parser (Content Posn) AttrGroup
attributeGroup Name -> Name -> QName
q)

-- | Parse an <xsd:element> decl.
elementDecl :: (String->String->QName) -> XsdParser ElementDecl
elementDecl :: (Name -> Name -> QName) -> Parser (Content Posn) ElementDecl
elementDecl Name -> Name -> QName
q =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"element"
       Parser (Content Posn) ElementDecl
-> Parser (Content Posn) ElementDecl
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) ElementDecl
 -> Parser (Content Posn) ElementDecl)
-> Parser (Content Posn) ElementDecl
-> Parser (Content Posn) ElementDecl
forall a b. (a -> b) -> a -> b
$ (Annotation
 -> Either NameAndType QName
 -> Occurs
 -> Bool
 -> Maybe QName
 -> Bool
 -> Maybe Final
 -> Maybe Final
 -> QForm
 -> Maybe (Either SimpleType ComplexType)
 -> [UniqueKeyOrKeyRef]
 -> ElementDecl)
-> Parser
     (Content Posn)
     (Annotation
      -> Either NameAndType QName
      -> Occurs
      -> Bool
      -> Maybe QName
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either NameAndType QName
-> Occurs
-> Bool
-> Maybe QName
-> Bool
-> Maybe Final
-> Maybe Final
-> QForm
-> Maybe (Either SimpleType ComplexType)
-> [UniqueKeyOrKeyRef]
-> ElementDecl
ElementDecl
           Parser
  (Content Posn)
  (Annotation
   -> Either NameAndType QName
   -> Occurs
   -> Bool
   -> Maybe QName
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either NameAndType QName
      -> Occurs
      -> Bool
      -> Maybe QName
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Either NameAndType QName
   -> Occurs
   -> Bool
   -> Maybe QName
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) (Either NameAndType QName)
-> Parser
     (Content Posn)
     (Occurs
      -> Bool
      -> Maybe QName
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` ((NameAndType -> Either NameAndType QName)
-> Parser (Content Posn) NameAndType
-> Parser (Content Posn) (Either NameAndType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameAndType -> Either NameAndType QName
forall a b. a -> Either a b
Left ((Name -> Name -> QName)
-> Element Posn -> Parser (Content Posn) NameAndType
nameAndType Name -> Name -> QName
q Element Posn
e)
                    Parser (Content Posn) (Either NameAndType QName)
-> Parser (Content Posn) (Either NameAndType QName)
-> Parser (Content Posn) (Either NameAndType QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                    (QName -> Either NameAndType QName)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Either NameAndType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either NameAndType QName
forall a b. b -> Either a b
Right (QName
-> TextParser QName -> Element Posn -> Parser (Content Posn) QName
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"ref") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e))
           Parser
  (Content Posn)
  (Occurs
   -> Bool
   -> Maybe QName
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) Occurs
-> Parser
     (Content Posn)
     (Bool
      -> Maybe QName
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Element Posn -> Parser (Content Posn) Occurs
occurs Element Posn
e
           Parser
  (Content Posn)
  (Bool
   -> Maybe QName
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> XsdParser Bool
-> Parser
     (Content Posn)
     (Maybe QName
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"nillable") TextParser Bool
bool Element Posn
e XsdParser Bool -> XsdParser Bool -> XsdParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Bool -> XsdParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           Parser
  (Content Posn)
  (Maybe QName
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) (Maybe QName)
-> Parser
     (Content Posn)
     (Bool
      -> Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
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 (Name -> QName
N Name
"substitutionGroup") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e)
           Parser
  (Content Posn)
  (Bool
   -> Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> XsdParser Bool
-> Parser
     (Content Posn)
     (Maybe Final
      -> Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"abstract") TextParser Bool
bool Element Posn
e XsdParser Bool -> XsdParser Bool -> XsdParser Bool
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Bool -> XsdParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           Parser
  (Content Posn)
  (Maybe Final
   -> Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) (Maybe Final)
-> Parser
     (Content Posn)
     (Maybe Final
      -> QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"final") TextParser Final
final Element Posn
e)
           Parser
  (Content Posn)
  (Maybe Final
   -> QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) (Maybe Final)
-> Parser
     (Content Posn)
     (QForm
      -> Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef]
      -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Final -> Parser (Content Posn) (Maybe Final)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Final -> Element Posn -> Parser (Content Posn) Final
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"block") TextParser Final
block Element Posn
e)
           Parser
  (Content Posn)
  (QForm
   -> Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef]
   -> ElementDecl)
-> Parser (Content Posn) QForm
-> Parser
     (Content Posn)
     (Maybe (Either SimpleType ComplexType)
      -> [UniqueKeyOrKeyRef] -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser QForm -> Element Posn -> Parser (Content Posn) QForm
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"form") TextParser QForm
qform Element Posn
e Parser (Content Posn) QForm
-> Parser (Content Posn) QForm -> Parser (Content Posn) QForm
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` QForm -> Parser (Content Posn) QForm
forall (m :: * -> *) a. Monad m => a -> m a
return QForm
Unqualified)
           Parser
  (Content Posn)
  (Maybe (Either SimpleType ComplexType)
   -> [UniqueKeyOrKeyRef] -> ElementDecl)
-> Parser (Content Posn) (Maybe (Either SimpleType ComplexType))
-> Parser (Content Posn) ([UniqueKeyOrKeyRef] -> ElementDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) (Maybe (Either SimpleType ComplexType))
-> Element Posn
-> Parser (Content Posn) (Maybe (Either SimpleType ComplexType))
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"simpleType" (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| Name -> Content Posn -> Bool
xsdTag Name
"complexType")
                                (Parser (Content Posn) (Either SimpleType ComplexType)
-> Parser (Content Posn) (Maybe (Either SimpleType ComplexType))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((SimpleType -> Either SimpleType ComplexType)
-> Parser (Content Posn) SimpleType
-> Parser (Content Posn) (Either SimpleType ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> Either SimpleType ComplexType
forall a b. a -> Either a b
Left ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
q)
                                           Parser (Content Posn) (Either SimpleType ComplexType)
-> Parser (Content Posn) (Either SimpleType ComplexType)
-> Parser (Content Posn) (Either SimpleType ComplexType)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                                           (ComplexType -> Either SimpleType ComplexType)
-> Parser (Content Posn) ComplexType
-> Parser (Content Posn) (Either SimpleType ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComplexType -> Either SimpleType ComplexType
forall a b. b -> Either a b
Right ((Name -> Name -> QName) -> Parser (Content Posn) ComplexType
complexType Name -> Name -> QName
q))) Element Posn
e
           Parser (Content Posn) ([UniqueKeyOrKeyRef] -> ElementDecl)
-> Parser (Content Posn) [UniqueKeyOrKeyRef]
-> Parser (Content Posn) ElementDecl
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [UniqueKeyOrKeyRef]
-> Element Posn
-> Parser (Content Posn) [UniqueKeyOrKeyRef]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"unique" (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| Name -> Content Posn -> Bool
xsdTag Name
"key"
                                                 (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| Name -> Content Posn -> Bool
xsdTag Name
"keyRef")
                                (Parser (Content Posn) UniqueKeyOrKeyRef
-> Parser (Content Posn) [UniqueKeyOrKeyRef]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Name -> Name -> QName) -> Parser (Content Posn) UniqueKeyOrKeyRef
uniqueKeyOrKeyRef Name -> Name -> QName
q)) Element Posn
e

-- | Parse name and type attributes.
nameAndType :: (String->String->QName) -> Element Posn -> XsdParser NameAndType
nameAndType :: (Name -> Name -> QName)
-> Element Posn -> Parser (Content Posn) NameAndType
nameAndType Name -> Name -> QName
q Element Posn
e = (Name -> Maybe QName -> NameAndType)
-> Parser (Content Posn) (Name -> Maybe QName -> NameAndType)
forall (m :: * -> *) a. Monad m => a -> m a
return Name -> Maybe QName -> NameAndType
NT Parser (Content Posn) (Name -> Maybe QName -> NameAndType)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Maybe QName -> NameAndType)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
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 (Name -> QName
N Name
"type") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e)

-- | Parse an <xsd:attribute> decl.
attributeDecl :: (String->String->QName) -> XsdParser AttributeDecl
attributeDecl :: (Name -> Name -> QName) -> Parser (Content Posn) AttributeDecl
attributeDecl Name -> Name -> QName
q =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"attribute"
       Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) AttributeDecl
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) AttributeDecl
 -> Parser (Content Posn) AttributeDecl)
-> Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) AttributeDecl
forall a b. (a -> b) -> a -> b
$ (Annotation
 -> Either NameAndType QName
 -> Use
 -> Maybe (Either Name Name)
 -> QForm
 -> Maybe SimpleType
 -> AttributeDecl)
-> Parser
     (Content Posn)
     (Annotation
      -> Either NameAndType QName
      -> Use
      -> Maybe (Either Name Name)
      -> QForm
      -> Maybe SimpleType
      -> AttributeDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either NameAndType QName
-> Use
-> Maybe (Either Name Name)
-> QForm
-> Maybe SimpleType
-> AttributeDecl
AttributeDecl
           Parser
  (Content Posn)
  (Annotation
   -> Either NameAndType QName
   -> Use
   -> Maybe (Either Name Name)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either NameAndType QName
      -> Use
      -> Maybe (Either Name Name)
      -> QForm
      -> Maybe SimpleType
      -> AttributeDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Either NameAndType QName
   -> Use
   -> Maybe (Either Name Name)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> Parser (Content Posn) (Either NameAndType QName)
-> Parser
     (Content Posn)
     (Use
      -> Maybe (Either Name Name)
      -> QForm
      -> Maybe SimpleType
      -> AttributeDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` ((NameAndType -> Either NameAndType QName)
-> Parser (Content Posn) NameAndType
-> Parser (Content Posn) (Either NameAndType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameAndType -> Either NameAndType QName
forall a b. a -> Either a b
Left ((Name -> Name -> QName)
-> Element Posn -> Parser (Content Posn) NameAndType
nameAndType Name -> Name -> QName
q Element Posn
e)
                    Parser (Content Posn) (Either NameAndType QName)
-> Parser (Content Posn) (Either NameAndType QName)
-> Parser (Content Posn) (Either NameAndType QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                    (QName -> Either NameAndType QName)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Either NameAndType QName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either NameAndType QName
forall a b. b -> Either a b
Right (QName
-> TextParser QName -> Element Posn -> Parser (Content Posn) QName
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"ref") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e))
           Parser
  (Content Posn)
  (Use
   -> Maybe (Either Name Name)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> Parser (Content Posn) Use
-> Parser
     (Content Posn)
     (Maybe (Either Name Name)
      -> QForm -> Maybe SimpleType -> AttributeDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser Use -> Element Posn -> Parser (Content Posn) Use
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"use") TextParser Use
use Element Posn
e Parser (Content Posn) Use
-> Parser (Content Posn) Use -> Parser (Content Posn) Use
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` Use -> Parser (Content Posn) Use
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Optional)
           Parser
  (Content Posn)
  (Maybe (Either Name Name)
   -> QForm -> Maybe SimpleType -> AttributeDecl)
-> Parser (Content Posn) (Maybe (Either Name Name))
-> Parser
     (Content Posn) (QForm -> Maybe SimpleType -> AttributeDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) (Either Name Name)
-> Parser (Content Posn) (Maybe (Either Name Name))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser (Either Name Name)
-> Element Posn
-> Parser (Content Posn) (Either Name Name)
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"default") ((Name -> Either Name Name)
-> TextParser Name -> TextParser (Either Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name Name
forall a b. a -> Either a b
Left TextParser Name
string) Element Posn
e
                              Parser (Content Posn) (Either Name Name)
-> Parser (Content Posn) (Either Name Name)
-> Parser (Content Posn) (Either Name Name)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                              QName
-> TextParser (Either Name Name)
-> Element Posn
-> Parser (Content Posn) (Either Name Name)
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"fixed") ((Name -> Either Name Name)
-> TextParser Name -> TextParser (Either Name Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name Name
forall a b. b -> Either a b
Right TextParser Name
string) Element Posn
e)
           Parser (Content Posn) (QForm -> Maybe SimpleType -> AttributeDecl)
-> Parser (Content Posn) QForm
-> Parser (Content Posn) (Maybe SimpleType -> AttributeDecl)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser QForm -> Element Posn -> Parser (Content Posn) QForm
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
xsd Name
"form") TextParser QForm
qform Element Posn
e Parser (Content Posn) QForm
-> Parser (Content Posn) QForm -> Parser (Content Posn) QForm
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` QForm -> Parser (Content Posn) QForm
forall (m :: * -> *) a. Monad m => a -> m a
return QForm
Unqualified)
           Parser (Content Posn) (Maybe SimpleType -> AttributeDecl)
-> Parser (Content Posn) (Maybe SimpleType)
-> Parser (Content Posn) AttributeDecl
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) (Maybe SimpleType)
-> Element Posn
-> Parser (Content Posn) (Maybe SimpleType)
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"simpleType")
                                (Parser (Content Posn) SimpleType
-> Parser (Content Posn) (Maybe SimpleType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Name -> Name -> QName) -> Parser (Content Posn) SimpleType
simpleType Name -> Name -> QName
q)) Element Posn
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 (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 (Name -> QName
N Name
"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 (Name -> QName
N Name
"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 Name -> TextParser Name
isWord Name
"unbounded"; Int -> TextParser Int
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 :: (Name -> Name -> QName) -> Parser (Content Posn) UniqueKeyOrKeyRef
uniqueKeyOrKeyRef Name -> Name -> QName
q = (Unique -> UniqueKeyOrKeyRef)
-> Parser (Content Posn) Unique
-> Parser (Content Posn) UniqueKeyOrKeyRef
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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyRef -> UniqueKeyOrKeyRef
KR ((Name -> Name -> QName) -> Parser (Content Posn) KeyRef
keyRef Name -> Name -> QName
q)

-- | Parse a <xsd:unique>.
unique :: XsdParser Unique
unique :: Parser (Content Posn) Unique
unique =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"unique"
       Parser (Content Posn) Unique -> Parser (Content Posn) Unique
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Unique -> Parser (Content Posn) Unique)
-> Parser (Content Posn) Unique -> Parser (Content Posn) Unique
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> Selector -> [Field] -> Unique)
-> Parser
     (Content Posn)
     (Annotation -> Name -> Selector -> [Field] -> Unique)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> Selector -> [Field] -> Unique
Unique
           Parser
  (Content Posn)
  (Annotation -> Name -> Selector -> [Field] -> Unique)
-> XsdParser Annotation
-> Parser (Content Posn) (Name -> Selector -> [Field] -> Unique)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Name -> Selector -> [Field] -> Unique)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Selector -> [Field] -> Unique)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e
           Parser (Content Posn) (Selector -> [Field] -> Unique)
-> Parser (Content Posn) Selector
-> Parser (Content Posn) ([Field] -> Unique)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) Selector
-> Element Posn
-> Parser (Content Posn) Selector
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"selector") Parser (Content Posn) Selector
selector Element Posn
e
           Parser (Content Posn) ([Field] -> Unique)
-> Parser (Content Posn) [Field] -> Parser (Content Posn) Unique
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [Field]
-> Element Posn
-> Parser (Content Posn) [Field]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"field") (Parser (Content Posn) Field -> Parser (Content Posn) [Field]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 Parser (Content Posn) Field
field_) Element Posn
e

-- | Parse a <xsd:key>.
key :: XsdParser Key
key :: Parser (Content Posn) Key
key =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"key"
       Parser (Content Posn) Key -> Parser (Content Posn) Key
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Key -> Parser (Content Posn) Key)
-> Parser (Content Posn) Key -> Parser (Content Posn) Key
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> Selector -> [Field] -> Key)
-> Parser
     (Content Posn) (Annotation -> Name -> Selector -> [Field] -> Key)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> Selector -> [Field] -> Key
Key
           Parser
  (Content Posn) (Annotation -> Name -> Selector -> [Field] -> Key)
-> XsdParser Annotation
-> Parser (Content Posn) (Name -> Selector -> [Field] -> Key)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Name -> Selector -> [Field] -> Key)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (Selector -> [Field] -> Key)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e
           Parser (Content Posn) (Selector -> [Field] -> Key)
-> Parser (Content Posn) Selector
-> Parser (Content Posn) ([Field] -> Key)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) Selector
-> Element Posn
-> Parser (Content Posn) Selector
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"selector") Parser (Content Posn) Selector
selector Element Posn
e
           Parser (Content Posn) ([Field] -> Key)
-> Parser (Content Posn) [Field] -> Parser (Content Posn) Key
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [Field]
-> Element Posn
-> Parser (Content Posn) [Field]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"field") (Parser (Content Posn) Field -> Parser (Content Posn) [Field]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 Parser (Content Posn) Field
field_) Element Posn
e

-- | Parse a <xsd:keyref>.
keyRef :: (String->String->QName) -> XsdParser KeyRef
keyRef :: (Name -> Name -> QName) -> Parser (Content Posn) KeyRef
keyRef Name -> Name -> QName
q =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"keyref"
       Parser (Content Posn) KeyRef -> Parser (Content Posn) KeyRef
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) KeyRef -> Parser (Content Posn) KeyRef)
-> Parser (Content Posn) KeyRef -> Parser (Content Posn) KeyRef
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> QName -> Selector -> [Field] -> KeyRef)
-> Parser
     (Content Posn)
     (Annotation -> Name -> QName -> Selector -> [Field] -> KeyRef)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> QName -> Selector -> [Field] -> KeyRef
KeyRef
           Parser
  (Content Posn)
  (Annotation -> Name -> QName -> Selector -> [Field] -> KeyRef)
-> XsdParser Annotation
-> Parser
     (Content Posn) (Name -> QName -> Selector -> [Field] -> KeyRef)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn) (Name -> QName -> Selector -> [Field] -> KeyRef)
-> Parser (Content Posn) Name
-> Parser (Content Posn) (QName -> Selector -> [Field] -> KeyRef)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"name") TextParser Name
string Element Posn
e
           Parser (Content Posn) (QName -> Selector -> [Field] -> KeyRef)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Selector -> [Field] -> KeyRef)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser QName -> Element Posn -> Parser (Content Posn) QName
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"refer") ((Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q) Element Posn
e
           Parser (Content Posn) (Selector -> [Field] -> KeyRef)
-> Parser (Content Posn) Selector
-> Parser (Content Posn) ([Field] -> KeyRef)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) Selector
-> Element Posn
-> Parser (Content Posn) Selector
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"selector") Parser (Content Posn) Selector
selector Element Posn
e
           Parser (Content Posn) ([Field] -> KeyRef)
-> Parser (Content Posn) [Field] -> Parser (Content Posn) KeyRef
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> Parser (Content Posn) [Field]
-> Element Posn
-> Parser (Content Posn) [Field]
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"field") (Parser (Content Posn) Field -> Parser (Content Posn) [Field]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 Parser (Content Posn) Field
field_) Element Posn
e

-- | Parse a <xsd:selector>.
selector :: XsdParser Selector
selector :: Parser (Content Posn) Selector
selector =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"selector"
       Parser (Content Posn) Selector -> Parser (Content Posn) Selector
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Selector -> Parser (Content Posn) Selector)
-> Parser (Content Posn) Selector -> Parser (Content Posn) Selector
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> Selector)
-> Parser (Content Posn) (Annotation -> Name -> Selector)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> Selector
Selector
           Parser (Content Posn) (Annotation -> Name -> Selector)
-> XsdParser Annotation -> Parser (Content Posn) (Name -> Selector)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Name -> Selector)
-> Parser (Content Posn) Name -> Parser (Content Posn) Selector
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"xpath") TextParser Name
string Element Posn
e

-- | Parse a <xsd:field>.
field_ :: XsdParser Field
field_ :: Parser (Content Posn) Field
field_ =
    do Element Posn
e <- Name -> XsdParser (Element Posn)
xsdElement Name
"field"
       Parser (Content Posn) Field -> Parser (Content Posn) Field
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser (Content Posn) Field -> Parser (Content Posn) Field)
-> Parser (Content Posn) Field -> Parser (Content Posn) Field
forall a b. (a -> b) -> a -> b
$ (Annotation -> Name -> Field)
-> Parser (Content Posn) (Annotation -> Name -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> Name -> Field
Field
           Parser (Content Posn) (Annotation -> Name -> Field)
-> XsdParser Annotation -> Parser (Content Posn) (Name -> Field)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (Content Posn -> Bool)
-> XsdParser Annotation -> Element Posn -> XsdParser Annotation
forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith (Name -> Content Posn -> Bool
xsdTag Name
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (Name -> Field)
-> Parser (Content Posn) Name -> Parser (Content Posn) Field
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser Name -> Element Posn -> Parser (Content Posn) Name
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (Name -> QName
N Name
"xpath") TextParser Name
string Element Posn
e

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

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

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

space :: TextParser String
space :: TextParser Name
space = Parser Char Char -> TextParser Name
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (Parser Char Char -> TextParser Name)
-> Parser Char Char -> TextParser Name
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 Name
w <- TextParser Name
word
          case Name
w of
            Name
"true"  -> Bool -> TextParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            Name
"false" -> Bool -> TextParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Name
"0"     -> Bool -> TextParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            Name
"1"     -> Bool -> TextParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Name
_       -> Name -> TextParser Bool
forall (m :: * -> *) a. MonadFail m => Name -> m a
fail Name
"could not parse boolean value"

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

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

-- | Parse an attribute value that should be a QName.
qname :: (String->String->QName) -> TextParser QName
qname :: (Name -> Name -> QName) -> TextParser QName
qname Name -> Name -> QName
q = do Name
a <- TextParser Name
word
             (do Name
":" <- TextParser Name
word
                 Name
b   <- Parser Char Char -> TextParser Name
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser Char Char
forall t. (t -> Bool) -> Parser t t
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':'))
                 QName -> TextParser QName
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Name -> QName
q Name
a Name
b)
               TextParser QName -> TextParser QName -> TextParser QName
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
               do Name
cs <- Parser Char Char -> TextParser Name
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char Char
forall t. Parser t t
next
                  QName -> TextParser QName
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> QName
N (Name
aName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
cs)))

-- | Parse an attribute value that should be a simple Name.
name :: TextParser Name
name :: TextParser Name
name = TextParser Name
word