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

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

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


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

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

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

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

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

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

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

-- | Grab and parse any and all children of the next element.
allChildren :: XsdParser a -> XsdParser a
allChildren :: forall a. XsdParser a -> XsdParser a
allChildren XsdParser a
p = do 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 :: forall a.
(Content Posn -> Bool)
-> XsdParser a -> Element Posn -> XsdParser a
interiorWith Content Posn -> Bool
keep (P [Content Posn] -> Result [Content Posn] a
p) (Elem QName
e [Attribute]
_ [Content Posn]
cs) = ([Content Posn] -> Result [Content Posn] a)
-> Parser (Content Posn) a
forall t a. ([t] -> Result [t] a) -> Parser t a
P (([Content Posn] -> Result [Content Posn] a)
 -> Parser (Content Posn) a)
-> ([Content Posn] -> Result [Content Posn] a)
-> Parser (Content Posn) a
forall a b. (a -> b) -> a -> b
$ \[Content Posn]
inp->
    [Content Posn]
-> Result [Content Posn] a -> Result [Content Posn] a
forall t x a. t -> Result x a -> Result t a
tidy [Content Posn]
inp (Result [Content Posn] a -> Result [Content Posn] a)
-> Result [Content Posn] a -> Result [Content Posn] a
forall a b. (a -> b) -> a -> b
$
    case [Content Posn] -> Result [Content Posn] a
p ((Content Posn -> Bool) -> [Content Posn] -> [Content Posn]
forall a. (a -> Bool) -> [a] -> [a]
filter Content Posn -> Bool
keep [Content Posn]
cs) of
        Committed Result [Content Posn] a
r        -> Result [Content Posn] a
r
        f :: Result [Content Posn] a
f@(Failure [Content Posn]
_ TargetNamespace
_)    -> Result [Content Posn] a
f
        s :: Result [Content Posn] a
s@(Success [] a
_)   -> Result [Content Posn] a
s
        Success ds :: [Content Posn]
ds@(Content Posn
d:[Content Posn]
_) a
a
            | (Content Posn -> Bool) -> [Content Posn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Content Posn -> Bool
forall {i}. Content i -> Bool
onlyMisc [Content Posn]
ds -> [Content Posn] -> a -> Result [Content Posn] a
forall z a. z -> a -> Result z a
Success [] a
a
            | Bool
otherwise       -> Result [Content Posn] a -> Result [Content Posn] a
forall z a. Result z a -> Result z a
Committed (Result [Content Posn] a -> Result [Content Posn] a)
-> Result [Content Posn] a -> Result [Content Posn] a
forall a b. (a -> b) -> a -> b
$
                                 [Content Posn] -> TargetNamespace -> Result [Content Posn] a
forall z a. z -> TargetNamespace -> Result z a
Failure [Content Posn]
ds (TargetNamespace
"Too many elements inside <"
                                             TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++QName -> TargetNamespace
printableName QName
eTargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++TargetNamespace
"> at\n"
                                             TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++Posn -> TargetNamespace
forall a. Show a => a -> TargetNamespace
show (Content Posn -> Posn
forall t. Content t -> t
info Content Posn
d)TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++TargetNamespace
"\n\n"
                                             TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++TargetNamespace
"Found excess: "
                                             TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++[Content Posn] -> TargetNamespace
forall a. Verbatim a => a -> TargetNamespace
verbatim (Int -> [Content Posn] -> [Content Posn]
forall a. Int -> [a] -> [a]
take Int
5 [Content Posn]
ds))
  where onlyMisc :: Content i -> Bool
onlyMisc (CMisc Misc
_ i
_) = Bool
True
        onlyMisc (CString Bool
False TargetNamespace
s i
_) | (Char -> Bool) -> TargetNamespace -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace TargetNamespace
s = Bool
True
        onlyMisc Content i
_ = Bool
False

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

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

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

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

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

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

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

-- Now for the real parsers.

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

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

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

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

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

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

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

-- | Parse a <xsd:redefine>.
redefine :: (String->String->QName) -> XsdParser SchemaItem
redefine :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SchemaItem
redefine TargetNamespace -> TargetNamespace -> QName
q = do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"redefine"
                Parser (Content Posn) SchemaItem
-> Parser (Content Posn) SchemaItem
forall a. XsdParser a -> XsdParser a
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
$ (TargetNamespace -> [SchemaItem] -> SchemaItem)
-> Parser
     (Content Posn) (TargetNamespace -> [SchemaItem] -> SchemaItem)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetNamespace -> [SchemaItem] -> SchemaItem
Redefine
                     Parser
  (Content Posn) (TargetNamespace -> [SchemaItem] -> SchemaItem)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) ([SchemaItem] -> SchemaItem)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"schemaLocation") TextParser TargetNamespace
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 a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SchemaItem
schemaItem TargetNamespace -> TargetNamespace -> QName
q)) Element Posn
e

-- | Parse a <xsd:simpleType> decl.
simpleType :: (String->String->QName) -> XsdParser SimpleType
simpleType :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SimpleType
simpleType TargetNamespace -> TargetNamespace -> QName
q = do
    Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"simpleType"
    Maybe TargetNamespace
n <- Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (Maybe TargetNamespace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e)
    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 (TargetNamespace -> QName
N TargetNamespace
"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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
    Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a. XsdParser a -> XsdParser a
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
. TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") (Maybe TargetNamespace
-> Maybe Final -> Annotation -> Parser (Content Posn) SimpleType
simpleItem Maybe TargetNamespace
n Maybe Final
f Annotation
a) Element Posn
e
  where
    simpleItem :: Maybe TargetNamespace
-> Maybe Final -> Annotation -> Parser (Content Posn) SimpleType
simpleItem Maybe TargetNamespace
n Maybe Final
f Annotation
a =
        do Element Posn
e  <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"restriction"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a. XsdParser a -> XsdParser a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"base") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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
. TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe TargetNamespace
-> Maybe Final
-> Restriction
-> SimpleType
Restricted Annotation
a Maybe TargetNamespace
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  <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"list"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a. XsdParser a -> XsdParser a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"itemType") ((QName -> Either SimpleType QName)
-> TextParser QName -> TextParser (Either SimpleType QName)
forall a b. (a -> b) -> Parser Char a -> Parser Char b
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 ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"simpleType")
                                ((SimpleType -> Either SimpleType QName)
-> Parser (Content Posn) SimpleType
-> XsdParser (Either SimpleType QName)
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> Either SimpleType QName
forall a b. a -> Either a b
Left ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SimpleType
simpleType TargetNamespace -> TargetNamespace -> QName
q)) Element Posn
e
                     XsdParser (Either SimpleType QName)
-> (TargetNamespace -> TargetNamespace)
-> XsdParser (Either SimpleType QName)
forall a.
Parser (Content Posn) a
-> (TargetNamespace -> TargetNamespace) -> Parser (Content Posn) a
forall (p :: * -> *) a.
Commitment p =>
p a -> (TargetNamespace -> TargetNamespace) -> p a
`adjustErr`
                   ((TargetNamespace
"Expected attribute 'itemType' or element <simpleType>\n"
                    TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++TargetNamespace
"  inside <list> decl.\n")TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++)
             SimpleType -> Parser (Content Posn) SimpleType
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe TargetNamespace
-> Maybe Final
-> Either SimpleType QName
-> SimpleType
ListOf (Annotation
aAnnotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend`Annotation
a1) Maybe TargetNamespace
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  <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"union"
           Parser (Content Posn) SimpleType
-> Parser (Content Posn) SimpleType
forall a. XsdParser a -> XsdParser a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"simpleType") (Parser (Content Posn) SimpleType -> XsdParser [SimpleType]
forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SimpleType
simpleType TargetNamespace -> TargetNamespace -> QName
q)) Element Posn
e
             [QName]
ms <- QName -> TextParser [QName] -> Element Posn -> XsdParser [QName]
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"memberTypes") (TextParser QName -> TextParser [QName]
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
             SimpleType -> Parser (Content Posn) SimpleType
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation
-> Maybe TargetNamespace
-> Maybe Final
-> [SimpleType]
-> [QName]
-> SimpleType
UnionOf (Annotation
aAnnotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend`Annotation
a1) Maybe TargetNamespace
n Maybe Final
f [SimpleType]
ts [QName]
ms)
        Parser (Content Posn) SimpleType
-> (TargetNamespace -> TargetNamespace)
-> Parser (Content Posn) SimpleType
forall a.
Parser (Content Posn) a
-> (TargetNamespace -> TargetNamespace) -> Parser (Content Posn) a
forall (p :: * -> *) a.
Commitment p =>
p a -> (TargetNamespace -> TargetNamespace) -> p a
`adjustErr`
        (TargetNamespace
"xsd:simpleType does not contain a restriction, list, or union\n"TargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++)

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

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

facet :: String -> FacetType -> XsdParser Facet
facet :: TargetNamespace -> FacetType -> Parser (Content Posn) Facet
facet TargetNamespace
s FacetType
t = do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
s
               TargetNamespace
v <- QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"value") TextParser TargetNamespace
string Element Posn
e
               Bool
f <- QName -> TextParser Bool -> Element Posn -> XsdParser Bool
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FacetType -> Annotation -> TargetNamespace -> Bool -> Facet
Facet FacetType
t Annotation
a TargetNamespace
v Bool
f)

-- | Parse a <xsd:complexType> decl.
complexType :: (String->String->QName) -> XsdParser ComplexType
complexType :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ComplexType
complexType TargetNamespace -> TargetNamespace -> QName
q =
    do Element Posn
e  <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"complexType"
       Parser (Content Posn) ComplexType
-> Parser (Content Posn) ComplexType
forall a. XsdParser a -> XsdParser a
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 TargetNamespace
 -> Bool
 -> Maybe Final
 -> Maybe Final
 -> Bool
 -> ComplexItem
 -> ComplexType)
-> Parser
     (Content Posn)
     (Annotation
      -> Maybe TargetNamespace
      -> Bool
      -> Maybe Final
      -> Maybe Final
      -> Bool
      -> ComplexItem
      -> ComplexType)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Maybe TargetNamespace
-> Bool
-> Maybe Final
-> Maybe Final
-> Bool
-> ComplexItem
-> ComplexType
ComplexType
           Parser
  (Content Posn)
  (Annotation
   -> Maybe TargetNamespace
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> Bool
   -> ComplexItem
   -> ComplexType)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Maybe TargetNamespace
      -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Maybe TargetNamespace
   -> Bool
   -> Maybe Final
   -> Maybe Final
   -> Bool
   -> ComplexItem
   -> ComplexType)
-> Parser (Content Posn) (Maybe TargetNamespace)
-> 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) TargetNamespace
-> Parser (Content Posn) (Maybe TargetNamespace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e)
           Parser
  (Content Posn)
  (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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> QName
N TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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
. TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ComplexItem
complexItem TargetNamespace -> TargetNamespace -> QName
q) Element Posn
e

-- | Parse the alternative contents of a <xsd:complexType> decl.
complexItem :: (String->String->QName) -> XsdParser ComplexItem
complexItem :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ComplexItem
complexItem TargetNamespace -> TargetNamespace -> QName
q =
    ( do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"simpleContent"
         Parser (Content Posn) ComplexItem
-> Parser (Content Posn) ComplexItem
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"complexContent"
         Parser (Content Posn) ComplexItem
-> Parser (Content Posn) ComplexItem
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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
<$> (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ParticleAttrs
particleAttrs TargetNamespace -> TargetNamespace -> QName
q
    )
  where
    stuff :: XsdParser (Either Restriction1 Extension)
    stuff :: Parser (Content Posn) (Either Restriction1 Extension)
stuff =
      ( do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"restriction"
           Parser (Content Posn) (Either Restriction1 Extension)
-> Parser (Content Posn) (Either Restriction1 Extension)
forall a. XsdParser a -> XsdParser a
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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Particle -> Restriction1
Restriction1 Parser (Content Posn) (Particle -> Restriction1)
-> Parser (Content Posn) Particle
-> Parser (Content Posn) Restriction1
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) Particle
particle TargetNamespace -> TargetNamespace -> QName
q
      ) 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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"extension"
           Parser (Content Posn) (Either Restriction1 Extension)
-> Parser (Content Posn) (Either Restriction1 Extension)
forall a. XsdParser a -> XsdParser a
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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> QName
N TargetNamespace
"base") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation")
                                    ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ParticleAttrs
particleAttrs TargetNamespace -> TargetNamespace -> QName
q) Element Posn
e
      )

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

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

-- | Parse an <xsd:all>, <xsd:choice>, or <xsd:sequence> decl.
choiceOrSeq :: (String->String->QName) -> XsdParser ChoiceOrSeq
choiceOrSeq :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq TargetNamespace -> TargetNamespace -> QName
q =
    do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"all"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation")
                                (Parser (Content Posn) ElementDecl
-> Parser (Content Posn) [ElementDecl]
forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementDecl
elementDecl TargetNamespace -> TargetNamespace -> 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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"choice"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation")
                                (Parser (Content Posn) ElementEtc
-> Parser (Content Posn) [ElementEtc]
forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementEtc
elementEtc TargetNamespace -> TargetNamespace -> 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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"sequence"
       Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ChoiceOrSeq
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation")
                                (Parser (Content Posn) ElementEtc
-> Parser (Content Posn) [ElementEtc]
forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementEtc
elementEtc TargetNamespace -> TargetNamespace -> QName
q)) Element Posn
e

-- | Parse a <xsd:group> decl.
group_ :: (String->String->QName) -> XsdParser Group
group_ :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) Group
group_ TargetNamespace -> TargetNamespace -> QName
q = do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"group"
              Parser (Content Posn) Group -> Parser (Content Posn) Group
forall a. XsdParser a -> XsdParser a
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 TargetNamespace QName
 -> Occurs
 -> Maybe ChoiceOrSeq
 -> Group)
-> Parser
     (Content Posn)
     (Annotation
      -> Either TargetNamespace QName
      -> Occurs
      -> Maybe ChoiceOrSeq
      -> Group)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either TargetNamespace QName
-> Occurs
-> Maybe ChoiceOrSeq
-> Group
Group
                Parser
  (Content Posn)
  (Annotation
   -> Either TargetNamespace QName
   -> Occurs
   -> Maybe ChoiceOrSeq
   -> Group)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either TargetNamespace 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
                Parser
  (Content Posn)
  (Either TargetNamespace QName
   -> Occurs -> Maybe ChoiceOrSeq -> Group)
-> Parser (Content Posn) (Either TargetNamespace QName)
-> Parser (Content Posn) (Occurs -> Maybe ChoiceOrSeq -> Group)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` ((TargetNamespace -> Either TargetNamespace QName)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (Either TargetNamespace QName)
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TargetNamespace -> Either TargetNamespace QName
forall a b. a -> Either a b
Left (QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e)
                         Parser (Content Posn) (Either TargetNamespace QName)
-> Parser (Content Posn) (Either TargetNamespace QName)
-> Parser (Content Posn) (Either TargetNamespace QName)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                         (QName -> Either TargetNamespace QName)
-> Parser (Content Posn) QName
-> Parser (Content Posn) (Either TargetNamespace QName)
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName -> Either TargetNamespace 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 (TargetNamespace -> QName
N TargetNamespace
"ref") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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
.TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation")
                                     (Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) (Maybe ChoiceOrSeq)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq TargetNamespace -> TargetNamespace -> 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 :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementEtc
elementEtc TargetNamespace -> TargetNamespace -> QName
q = (ElementDecl -> ElementEtc)
-> Parser (Content Posn) ElementDecl
-> Parser (Content Posn) ElementEtc
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElementDecl -> ElementEtc
HasElement ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementDecl
elementDecl TargetNamespace -> TargetNamespace -> QName
q)
             Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
             (Group -> ElementEtc)
-> Parser (Content Posn) Group -> Parser (Content Posn) ElementEtc
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Group -> ElementEtc
HasGroup ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) Group
group_ TargetNamespace -> TargetNamespace -> QName
q)
             Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
             (ChoiceOrSeq -> ElementEtc)
-> Parser (Content Posn) ChoiceOrSeq
-> Parser (Content Posn) ElementEtc
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChoiceOrSeq -> ElementEtc
HasCS ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ChoiceOrSeq
choiceOrSeq TargetNamespace -> TargetNamespace -> QName
q)
             Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
-> Parser (Content Posn) ElementEtc
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
             (Any -> ElementEtc)
-> Parser (Content Posn) Any -> Parser (Content Posn) ElementEtc
forall a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any -> ElementEtc
HasAny Parser (Content Posn) Any
any_

-- | Parse an <xsd:any>.
any_ :: XsdParser Any
any_ :: Parser (Content Posn) Any
any_ = do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"any"
          Parser (Content Posn) Any -> Parser (Content Posn) Any
forall a. XsdParser a -> XsdParser a
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 -> TargetNamespace -> ProcessContents -> Occurs -> Any)
-> Parser
     (Content Posn)
     (Annotation -> TargetNamespace -> ProcessContents -> Occurs -> Any)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> TargetNamespace -> ProcessContents -> Occurs -> Any
Any
              Parser
  (Content Posn)
  (Annotation -> TargetNamespace -> ProcessContents -> Occurs -> Any)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
              Parser
  (Content Posn)
  (TargetNamespace -> ProcessContents -> Occurs -> Any)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (ProcessContents -> Occurs -> Any)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"namespace") TextParser TargetNamespace
uri Element Posn
e
                       Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) TargetNamespace
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` TargetNamespace -> Parser (Content Posn) TargetNamespace
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetNamespace
"##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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"anyAttribute"
             Parser (Content Posn) AnyAttr -> Parser (Content Posn) AnyAttr
forall a. XsdParser a -> XsdParser a
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 -> TargetNamespace -> ProcessContents -> AnyAttr)
-> Parser
     (Content Posn)
     (Annotation -> TargetNamespace -> ProcessContents -> AnyAttr)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> TargetNamespace -> ProcessContents -> AnyAttr
AnyAttr
                 Parser
  (Content Posn)
  (Annotation -> TargetNamespace -> ProcessContents -> AnyAttr)
-> XsdParser Annotation
-> Parser
     (Content Posn) (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
                 Parser
  (Content Posn) (TargetNamespace -> ProcessContents -> AnyAttr)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (ProcessContents -> AnyAttr)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` (QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"namespace") TextParser TargetNamespace
uri Element Posn
e
                          Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) TargetNamespace
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail` TargetNamespace -> Parser (Content Posn) TargetNamespace
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetNamespace
"##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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContents
Strict)

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

-- | Parse an <xsd:element> decl.
elementDecl :: (String->String->QName) -> XsdParser ElementDecl
elementDecl :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ElementDecl
elementDecl TargetNamespace -> TargetNamespace -> QName
q =
    do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"element"
       Parser (Content Posn) ElementDecl
-> Parser (Content Posn) ElementDecl
forall a. XsdParser a -> XsdParser a
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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameAndType -> Either NameAndType QName
forall a b. a -> Either a b
Left ((TargetNamespace -> TargetNamespace -> QName)
-> Element Posn -> Parser (Content Posn) NameAndType
nameAndType TargetNamespace -> TargetNamespace -> 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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (TargetNamespace -> QName
N TargetNamespace
"ref") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> QName
N TargetNamespace
"substitutionGroup") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> QName
xsd TargetNamespace
"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 (TargetNamespace -> QName
xsd TargetNamespace
"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 (TargetNamespace -> QName
xsd TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"simpleType" (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleType -> Either SimpleType ComplexType
forall a b. a -> Either a b
Left ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SimpleType
simpleType TargetNamespace -> TargetNamespace -> 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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ComplexType -> Either SimpleType ComplexType
forall a b. b -> Either a b
Right ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) ComplexType
complexType TargetNamespace -> TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"unique" (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"key"
                                                 (Content Posn -> Bool)
-> (Content Posn -> Bool) -> Content Posn -> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"keyRef")
                                (Parser (Content Posn) UniqueKeyOrKeyRef
-> Parser (Content Posn) [UniqueKeyOrKeyRef]
forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) UniqueKeyOrKeyRef
uniqueKeyOrKeyRef TargetNamespace -> TargetNamespace -> QName
q)) Element Posn
e

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

-- | Parse an <xsd:attribute> decl.
attributeDecl :: (String->String->QName) -> XsdParser AttributeDecl
attributeDecl :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) AttributeDecl
attributeDecl TargetNamespace -> TargetNamespace -> QName
q =
    do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"attribute"
       Parser (Content Posn) AttributeDecl
-> Parser (Content Posn) AttributeDecl
forall a. XsdParser a -> XsdParser a
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 TargetNamespace TargetNamespace)
 -> QForm
 -> Maybe SimpleType
 -> AttributeDecl)
-> Parser
     (Content Posn)
     (Annotation
      -> Either NameAndType QName
      -> Use
      -> Maybe (Either TargetNamespace TargetNamespace)
      -> QForm
      -> Maybe SimpleType
      -> AttributeDecl)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> Either NameAndType QName
-> Use
-> Maybe (Either TargetNamespace TargetNamespace)
-> QForm
-> Maybe SimpleType
-> AttributeDecl
AttributeDecl
           Parser
  (Content Posn)
  (Annotation
   -> Either NameAndType QName
   -> Use
   -> Maybe (Either TargetNamespace TargetNamespace)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (Either NameAndType QName
      -> Use
      -> Maybe (Either TargetNamespace TargetNamespace)
      -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (Either NameAndType QName
   -> Use
   -> Maybe (Either TargetNamespace TargetNamespace)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> Parser (Content Posn) (Either NameAndType QName)
-> Parser
     (Content Posn)
     (Use
      -> Maybe (Either TargetNamespace TargetNamespace)
      -> 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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameAndType -> Either NameAndType QName
forall a b. a -> Either a b
Left ((TargetNamespace -> TargetNamespace -> QName)
-> Element Posn -> Parser (Content Posn) NameAndType
nameAndType TargetNamespace -> TargetNamespace -> 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 a b.
(a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (TargetNamespace -> QName
N TargetNamespace
"ref") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> QName
q) Element Posn
e))
           Parser
  (Content Posn)
  (Use
   -> Maybe (Either TargetNamespace TargetNamespace)
   -> QForm
   -> Maybe SimpleType
   -> AttributeDecl)
-> Parser (Content Posn) Use
-> Parser
     (Content Posn)
     (Maybe (Either TargetNamespace TargetNamespace)
      -> 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 (TargetNamespace -> QName
N TargetNamespace
"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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Optional)
           Parser
  (Content Posn)
  (Maybe (Either TargetNamespace TargetNamespace)
   -> QForm -> Maybe SimpleType -> AttributeDecl)
-> Parser
     (Content Posn) (Maybe (Either TargetNamespace TargetNamespace))
-> 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 TargetNamespace TargetNamespace)
-> Parser
     (Content Posn) (Maybe (Either TargetNamespace TargetNamespace))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser (Either TargetNamespace TargetNamespace)
-> Element Posn
-> Parser (Content Posn) (Either TargetNamespace TargetNamespace)
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"default") ((TargetNamespace -> Either TargetNamespace TargetNamespace)
-> TextParser TargetNamespace
-> TextParser (Either TargetNamespace TargetNamespace)
forall a b. (a -> b) -> Parser Char a -> Parser Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TargetNamespace -> Either TargetNamespace TargetNamespace
forall a b. a -> Either a b
Left TextParser TargetNamespace
string) Element Posn
e
                              Parser (Content Posn) (Either TargetNamespace TargetNamespace)
-> Parser (Content Posn) (Either TargetNamespace TargetNamespace)
-> Parser (Content Posn) (Either TargetNamespace TargetNamespace)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                              QName
-> TextParser (Either TargetNamespace TargetNamespace)
-> Element Posn
-> Parser (Content Posn) (Either TargetNamespace TargetNamespace)
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"fixed") ((TargetNamespace -> Either TargetNamespace TargetNamespace)
-> TextParser TargetNamespace
-> TextParser (Either TargetNamespace TargetNamespace)
forall a b. (a -> b) -> Parser Char a -> Parser Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TargetNamespace -> Either TargetNamespace TargetNamespace
forall a b. b -> Either a b
Right TextParser TargetNamespace
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 (TargetNamespace -> QName
xsd TargetNamespace
"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 a. a -> Parser (Content Posn) a
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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"simpleType")
                                (Parser (Content Posn) SimpleType
-> Parser (Content Posn) (Maybe SimpleType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) SimpleType
simpleType TargetNamespace -> TargetNamespace -> QName
q)) 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 a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int -> Maybe Int -> Occurs
Occurs
               Parser (Content Posn) (Maybe Int -> Maybe Int -> Occurs)
-> Parser (Content Posn) (Maybe Int)
-> Parser (Content Posn) (Maybe Int -> Occurs)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Int -> Parser (Content Posn) (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Int -> Element Posn -> Parser (Content Posn) Int
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"minOccurs") TextParser Int
forall a. Integral a => TextParser a
parseDec Element Posn
e)
               Parser (Content Posn) (Maybe Int -> Occurs)
-> Parser (Content Posn) (Maybe Int)
-> Parser (Content Posn) Occurs
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` Parser (Content Posn) Int -> Parser (Content Posn) (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName
-> TextParser Int -> Element Posn -> Parser (Content Posn) Int
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"maxOccurs") TextParser Int
maxDec Element Posn
e)
  where
    maxDec :: TextParser Int
maxDec = TextParser Int
forall a. Integral a => TextParser a
parseDec
             TextParser Int -> TextParser Int -> TextParser Int
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
             do TargetNamespace -> TextParser TargetNamespace
isWord TargetNamespace
"unbounded"; Int -> TextParser Int
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
forall a. Bounded a => a
maxBound

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

-- | Parse a <xsd:unique>.
unique :: XsdParser Unique
unique :: Parser (Content Posn) Unique
unique =
    do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"unique"
       Parser (Content Posn) Unique -> Parser (Content Posn) Unique
forall a. XsdParser a -> XsdParser a
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 -> TargetNamespace -> Selector -> [Field] -> Unique)
-> Parser
     (Content Posn)
     (Annotation -> TargetNamespace -> Selector -> [Field] -> Unique)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> TargetNamespace -> Selector -> [Field] -> Unique
Unique
           Parser
  (Content Posn)
  (Annotation -> TargetNamespace -> Selector -> [Field] -> Unique)
-> XsdParser Annotation
-> Parser
     (Content Posn) (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn) (TargetNamespace -> Selector -> [Field] -> Unique)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (Selector -> [Field] -> Unique)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e
           Parser (Content Posn) (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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"key"
       Parser (Content Posn) Key -> Parser (Content Posn) Key
forall a. XsdParser a -> XsdParser a
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 -> TargetNamespace -> Selector -> [Field] -> Key)
-> Parser
     (Content Posn)
     (Annotation -> TargetNamespace -> Selector -> [Field] -> Key)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> TargetNamespace -> Selector -> [Field] -> Key
Key
           Parser
  (Content Posn)
  (Annotation -> TargetNamespace -> Selector -> [Field] -> Key)
-> XsdParser Annotation
-> Parser
     (Content Posn) (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn) (TargetNamespace -> Selector -> [Field] -> Key)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (Selector -> [Field] -> Key)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e
           Parser (Content Posn) (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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 :: (TargetNamespace -> TargetNamespace -> QName)
-> Parser (Content Posn) KeyRef
keyRef TargetNamespace -> TargetNamespace -> QName
q =
    do Element Posn
e <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"keyref"
       Parser (Content Posn) KeyRef -> Parser (Content Posn) KeyRef
forall a. XsdParser a -> XsdParser a
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
 -> TargetNamespace -> QName -> Selector -> [Field] -> KeyRef)
-> Parser
     (Content Posn)
     (Annotation
      -> TargetNamespace -> QName -> Selector -> [Field] -> KeyRef)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation
-> TargetNamespace -> QName -> Selector -> [Field] -> KeyRef
KeyRef
           Parser
  (Content Posn)
  (Annotation
   -> TargetNamespace -> QName -> Selector -> [Field] -> KeyRef)
-> XsdParser Annotation
-> Parser
     (Content Posn)
     (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser
  (Content Posn)
  (TargetNamespace -> QName -> Selector -> [Field] -> KeyRef)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) (QName -> Selector -> [Field] -> KeyRef)
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"name") TextParser TargetNamespace
string Element Posn
e
           Parser (Content Posn) (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 (TargetNamespace -> QName
N TargetNamespace
"refer") ((TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"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 <- TargetNamespace -> XsdParser (Element Posn)
xsdElement TargetNamespace
"selector"
       Parser (Content Posn) Selector -> Parser (Content Posn) Selector
forall a. XsdParser a -> XsdParser a
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 -> TargetNamespace -> Selector)
-> Parser
     (Content Posn) (Annotation -> TargetNamespace -> Selector)
forall a. a -> Parser (Content Posn) a
forall (m :: * -> *) a. Monad m => a -> m a
return Annotation -> TargetNamespace -> Selector
Selector
           Parser (Content Posn) (Annotation -> TargetNamespace -> Selector)
-> XsdParser Annotation
-> Parser (Content Posn) (TargetNamespace -> 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 (TargetNamespace -> Content Posn -> Bool
xsdTag TargetNamespace
"annotation") XsdParser Annotation
annotation Element Posn
e
           Parser (Content Posn) (TargetNamespace -> Selector)
-> Parser (Content Posn) TargetNamespace
-> Parser (Content Posn) Selector
forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` QName
-> TextParser TargetNamespace
-> Element Posn
-> Parser (Content Posn) TargetNamespace
forall a. QName -> TextParser a -> Element Posn -> XsdParser a
attribute (TargetNamespace -> QName
N TargetNamespace
"xpath") TextParser TargetNamespace
string Element Posn
e

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

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

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

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

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

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

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

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

-- | Parse an attribute value that should be a QName.
qname :: (String->String->QName) -> TextParser QName
qname :: (TargetNamespace -> TargetNamespace -> QName) -> TextParser QName
qname TargetNamespace -> TargetNamespace -> QName
q = do TargetNamespace
a <- TextParser TargetNamespace
word
             do TargetNamespace
":" <- TextParser TargetNamespace
word
                TargetNamespace
b   <- Parser Char Char -> TextParser TargetNamespace
forall a. Parser Char a -> Parser Char [a]
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 a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetNamespace -> TargetNamespace -> QName
q TargetNamespace
a TargetNamespace
b)
               TextParser QName -> TextParser QName -> TextParser QName
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
                 do TargetNamespace
cs <- Parser Char Char -> TextParser TargetNamespace
forall a. Parser Char a -> Parser Char [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char Char
forall t. Parser t t
next
                    QName -> TextParser QName
forall a. a -> Parser Char a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetNamespace -> QName
N (TargetNamespace
aTargetNamespace -> TargetNamespace -> TargetNamespace
forall a. [a] -> [a] -> [a]
++TargetNamespace
cs))