{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

-- | Parse an XSD into types with the ability to resolve references.
module Fadno.Xml.ParseXsd
    (
     -- * Parsers and utilities
    parseFile, loadXsdSchema, schemaParser, namespaceSchema
    ,qnParser, attrParser, parsec, qn, anySimpleTypeName
     -- * Type References
    ,Resolvable (..)
    ,refResolve
     -- * Schema, QNs, Refs
    ,Ref (..),unresolved,resolved,refvalue
    ,Schema (..),simpleTypes,complexTypes,groups,attributeGroups,elements,attributes
    ,QN (..),qLocal,qPrefix
    -- * Productions
    ,SimpleType(..),simpleTypeName,simpleTypeRestriction,simpleTypeUnion,simpleTypeDoc
    ,Bound(..)
    ,SimpleRestriction(..),simpleRestrictBase,simpleRestrictEnums,simpleRestrictMin,simpleRestrictMax,simpleRestrictPattern
    ,Union(..),unionMemberTypes,unionSimpleTypes
    ,Attribute(..),attrName,attrType,attrUse,attrDefault,attrRef,attrSimpleType
    ,Use(..)
    ,AttributeGroup(..),attrGroupName,attrGroupAttributes,attrGroupRef,attrGroupDoc
    ,Attributes(..),attrsAttributes,attrsAttributeGroups
    ,Occurs(..),occursMin,occursMax
    ,Element(..),elementName,elementType,elementOccurs,elementSimple,elementComplex,elementRef,elementDoc
    ,ComplexType(..),complexTypeName,complexSimpleContent,complexComplexContent,complexCompositor,complexAttributes,complexTypeDoc
    ,SimpleContent(..),simpleContentBase,simpleContentAttributes
    ,ComplexContent(..),complexContentBase,complexContentAttributes,complexContentCompositor
    ,Compositor(..),compGroup,compChoice,compSequence
    ,Group(..),groupName,groupOccurs,groupChoice,groupSequence,groupRef,groupDoc
    ,Particle(..),partElement,partGroup,partChoice,partSequence
    ,Choice(..),choiceOccurs,choiceParticles
    ,Sequence(..),sequenceOccurs,sequenceParticles
    ,Documentation(..)
    ) where

import Control.Monad.State.Strict hiding (sequence)
import Control.Monad.Except hiding (sequence)
import Data.Either
import Data.Semigroup
import Control.Applicative
import Prelude hiding (sequence)
import Fadno.Xml.XParser
import Control.Lens hiding (Choice,element,elements)
import Data.Data.Lens
import Data.Data
import qualified Text.Parsec as P
import Control.Exception
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import Data.Maybe


-- | Model an outward XSD reference.
data Ref a =
    -- | Just type name.
    Unresolved { Ref a -> QN
_unresolved :: !QN } |
    -- | Type name and resolved value.
    Resolved { Ref a -> QN
_resolved :: !QN,
               Ref a -> a
_refvalue ::  !a } |
    -- | Reserved for built-in types (string, etc)
    Final
    deriving (Typeable (Ref a)
DataType
Constr
Typeable (Ref a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Ref a -> c (Ref a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Ref a))
-> (Ref a -> Constr)
-> (Ref a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Ref a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ref a)))
-> ((forall b. Data b => b -> b) -> Ref a -> Ref a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ref a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ref a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ref a -> m (Ref a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ref a -> m (Ref a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ref a -> m (Ref a))
-> Data (Ref a)
Ref a -> DataType
Ref a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Ref a))
(forall b. Data b => b -> b) -> Ref a -> Ref a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ref a -> c (Ref a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ref a)
forall a. Data a => Typeable (Ref a)
forall a. Data a => Ref a -> DataType
forall a. Data a => Ref a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> Ref a -> Ref a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Ref a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Ref a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ref a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ref a -> c (Ref a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ref a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ref a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ref a -> u
forall u. (forall d. Data d => d -> u) -> Ref a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ref a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ref a -> c (Ref a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ref a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ref a))
$cFinal :: Constr
$cResolved :: Constr
$cUnresolved :: Constr
$tRef :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
gmapMp :: (forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
gmapM :: (forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Ref a -> m (Ref a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Ref a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Ref a -> u
gmapQ :: (forall d. Data d => d -> u) -> Ref a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Ref a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ref a -> r
gmapT :: (forall b. Data b => b -> b) -> Ref a -> Ref a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Ref a -> Ref a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ref a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Ref a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Ref a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ref a))
dataTypeOf :: Ref a -> DataType
$cdataTypeOf :: forall a. Data a => Ref a -> DataType
toConstr :: Ref a -> Constr
$ctoConstr :: forall a. Data a => Ref a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ref a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ref a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ref a -> c (Ref a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ref a -> c (Ref a)
$cp1Data :: forall a. Data a => Typeable (Ref a)
Data,Typeable,Ref a -> Ref a -> Bool
(Ref a -> Ref a -> Bool) -> (Ref a -> Ref a -> Bool) -> Eq (Ref a)
forall a. Eq a => Ref a -> Ref a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref a -> Ref a -> Bool
$c/= :: forall a. Eq a => Ref a -> Ref a -> Bool
== :: Ref a -> Ref a -> Bool
$c== :: forall a. Eq a => Ref a -> Ref a -> Bool
Eq)

instance Show (Ref a) where
    show :: Ref a -> String
show (Unresolved QN
a) = String
"Unresolved " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QN -> String
forall a. Show a => a -> String
show QN
a
    show (Resolved QN
n a
_) = String
"Resolved " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QN -> String
forall a. Show a => a -> String
show QN
n -- avoid circular stuff
    show Ref a
Final = String
"Final"

-- | QName type.
data QN = QN { QN -> String
_qLocal :: String, QN -> Maybe String
_qPrefix :: Maybe String }
        deriving (Typeable QN
DataType
Constr
Typeable QN
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> QN -> c QN)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c QN)
-> (QN -> Constr)
-> (QN -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c QN))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QN))
-> ((forall b. Data b => b -> b) -> QN -> QN)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r)
-> (forall u. (forall d. Data d => d -> u) -> QN -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> QN -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> QN -> m QN)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QN -> m QN)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QN -> m QN)
-> Data QN
QN -> DataType
QN -> Constr
(forall b. Data b => b -> b) -> QN -> QN
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QN -> c QN
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QN
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QN -> u
forall u. (forall d. Data d => d -> u) -> QN -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QN -> m QN
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QN -> m QN
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QN
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QN -> c QN
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QN)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QN)
$cQN :: Constr
$tQN :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> QN -> m QN
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QN -> m QN
gmapMp :: (forall d. Data d => d -> m d) -> QN -> m QN
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QN -> m QN
gmapM :: (forall d. Data d => d -> m d) -> QN -> m QN
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QN -> m QN
gmapQi :: Int -> (forall d. Data d => d -> u) -> QN -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QN -> u
gmapQ :: (forall d. Data d => d -> u) -> QN -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QN -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QN -> r
gmapT :: (forall b. Data b => b -> b) -> QN -> QN
$cgmapT :: (forall b. Data b => b -> b) -> QN -> QN
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QN)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QN)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c QN)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QN)
dataTypeOf :: QN -> DataType
$cdataTypeOf :: QN -> DataType
toConstr :: QN -> Constr
$ctoConstr :: QN -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QN
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QN
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QN -> c QN
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QN -> c QN
$cp1Data :: Typeable QN
Data,Typeable,QN -> QN -> Bool
(QN -> QN -> Bool) -> (QN -> QN -> Bool) -> Eq QN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QN -> QN -> Bool
$c/= :: QN -> QN -> Bool
== :: QN -> QN -> Bool
$c== :: QN -> QN -> Bool
Eq,Eq QN
Eq QN
-> (QN -> QN -> Ordering)
-> (QN -> QN -> Bool)
-> (QN -> QN -> Bool)
-> (QN -> QN -> Bool)
-> (QN -> QN -> Bool)
-> (QN -> QN -> QN)
-> (QN -> QN -> QN)
-> Ord QN
QN -> QN -> Bool
QN -> QN -> Ordering
QN -> QN -> QN
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QN -> QN -> QN
$cmin :: QN -> QN -> QN
max :: QN -> QN -> QN
$cmax :: QN -> QN -> QN
>= :: QN -> QN -> Bool
$c>= :: QN -> QN -> Bool
> :: QN -> QN -> Bool
$c> :: QN -> QN -> Bool
<= :: QN -> QN -> Bool
$c<= :: QN -> QN -> Bool
< :: QN -> QN -> Bool
$c< :: QN -> QN -> Bool
compare :: QN -> QN -> Ordering
$ccompare :: QN -> QN -> Ordering
$cp1Ord :: Eq QN
Ord)
instance Show QN
    where show :: QN -> String
show (QN String
l Maybe String
Nothing) = String
l
          show (QN String
l (Just String
p)) = String
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:String
l

newtype Documentation = Documentation String
    deriving (Documentation -> Documentation -> Bool
(Documentation -> Documentation -> Bool)
-> (Documentation -> Documentation -> Bool) -> Eq Documentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Documentation -> Documentation -> Bool
$c/= :: Documentation -> Documentation -> Bool
== :: Documentation -> Documentation -> Bool
$c== :: Documentation -> Documentation -> Bool
Eq,Eq Documentation
Eq Documentation
-> (Documentation -> Documentation -> Ordering)
-> (Documentation -> Documentation -> Bool)
-> (Documentation -> Documentation -> Bool)
-> (Documentation -> Documentation -> Bool)
-> (Documentation -> Documentation -> Bool)
-> (Documentation -> Documentation -> Documentation)
-> (Documentation -> Documentation -> Documentation)
-> Ord Documentation
Documentation -> Documentation -> Bool
Documentation -> Documentation -> Ordering
Documentation -> Documentation -> Documentation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Documentation -> Documentation -> Documentation
$cmin :: Documentation -> Documentation -> Documentation
max :: Documentation -> Documentation -> Documentation
$cmax :: Documentation -> Documentation -> Documentation
>= :: Documentation -> Documentation -> Bool
$c>= :: Documentation -> Documentation -> Bool
> :: Documentation -> Documentation -> Bool
$c> :: Documentation -> Documentation -> Bool
<= :: Documentation -> Documentation -> Bool
$c<= :: Documentation -> Documentation -> Bool
< :: Documentation -> Documentation -> Bool
$c< :: Documentation -> Documentation -> Bool
compare :: Documentation -> Documentation -> Ordering
$ccompare :: Documentation -> Documentation -> Ordering
$cp1Ord :: Eq Documentation
Ord,Typeable Documentation
DataType
Constr
Typeable Documentation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Documentation -> c Documentation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Documentation)
-> (Documentation -> Constr)
-> (Documentation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Documentation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Documentation))
-> ((forall b. Data b => b -> b) -> Documentation -> Documentation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Documentation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Documentation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Documentation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Documentation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Documentation -> m Documentation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Documentation -> m Documentation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Documentation -> m Documentation)
-> Data Documentation
Documentation -> DataType
Documentation -> Constr
(forall b. Data b => b -> b) -> Documentation -> Documentation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Documentation -> c Documentation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Documentation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Documentation -> u
forall u. (forall d. Data d => d -> u) -> Documentation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Documentation -> m Documentation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Documentation -> m Documentation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Documentation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Documentation -> c Documentation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Documentation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Documentation)
$cDocumentation :: Constr
$tDocumentation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Documentation -> m Documentation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Documentation -> m Documentation
gmapMp :: (forall d. Data d => d -> m d) -> Documentation -> m Documentation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Documentation -> m Documentation
gmapM :: (forall d. Data d => d -> m d) -> Documentation -> m Documentation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Documentation -> m Documentation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Documentation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Documentation -> u
gmapQ :: (forall d. Data d => d -> u) -> Documentation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Documentation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Documentation -> r
gmapT :: (forall b. Data b => b -> b) -> Documentation -> Documentation
$cgmapT :: (forall b. Data b => b -> b) -> Documentation -> Documentation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Documentation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Documentation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Documentation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Documentation)
dataTypeOf :: Documentation -> DataType
$cdataTypeOf :: Documentation -> DataType
toConstr :: Documentation -> Constr
$ctoConstr :: Documentation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Documentation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Documentation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Documentation -> c Documentation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Documentation -> c Documentation
$cp1Data :: Typeable Documentation
Data,Typeable)
instance Show Documentation where show :: Documentation -> String
show (Documentation String
a) = ShowS
forall a. Show a => a -> String
show String
a

-- | XSD simpleType production.
data SimpleType =
    SimpleTypeRestrict {
      SimpleType -> Maybe QN
_simpleTypeName :: !(Maybe QN),
      SimpleType -> SimpleRestriction
_simpleTypeRestriction :: !SimpleRestriction,
      SimpleType -> Maybe Documentation
_simpleTypeDoc :: Maybe Documentation } |
    SimpleTypeUnion {
      _simpleTypeName :: !(Maybe QN),
      SimpleType -> Union
_simpleTypeUnion :: !Union,
      _simpleTypeDoc :: Maybe Documentation }
    deriving (Typeable SimpleType
DataType
Constr
Typeable SimpleType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SimpleType -> c SimpleType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SimpleType)
-> (SimpleType -> Constr)
-> (SimpleType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SimpleType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SimpleType))
-> ((forall b. Data b => b -> b) -> SimpleType -> SimpleType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleType -> r)
-> (forall u. (forall d. Data d => d -> u) -> SimpleType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SimpleType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType)
-> Data SimpleType
SimpleType -> DataType
SimpleType -> Constr
(forall b. Data b => b -> b) -> SimpleType -> SimpleType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleType -> c SimpleType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SimpleType -> u
forall u. (forall d. Data d => d -> u) -> SimpleType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleType -> c SimpleType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SimpleType)
$cSimpleTypeUnion :: Constr
$cSimpleTypeRestrict :: Constr
$tSimpleType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
gmapMp :: (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
gmapM :: (forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SimpleType -> m SimpleType
gmapQi :: Int -> (forall d. Data d => d -> u) -> SimpleType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SimpleType -> u
gmapQ :: (forall d. Data d => d -> u) -> SimpleType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleType -> r
gmapT :: (forall b. Data b => b -> b) -> SimpleType -> SimpleType
$cgmapT :: (forall b. Data b => b -> b) -> SimpleType -> SimpleType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SimpleType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SimpleType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SimpleType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleType)
dataTypeOf :: SimpleType -> DataType
$cdataTypeOf :: SimpleType -> DataType
toConstr :: SimpleType -> Constr
$ctoConstr :: SimpleType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleType -> c SimpleType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleType -> c SimpleType
$cp1Data :: Typeable SimpleType
Data,Typeable,SimpleType -> SimpleType -> Bool
(SimpleType -> SimpleType -> Bool)
-> (SimpleType -> SimpleType -> Bool) -> Eq SimpleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleType -> SimpleType -> Bool
$c/= :: SimpleType -> SimpleType -> Bool
== :: SimpleType -> SimpleType -> Bool
$c== :: SimpleType -> SimpleType -> Bool
Eq,Int -> SimpleType -> ShowS
[SimpleType] -> ShowS
SimpleType -> String
(Int -> SimpleType -> ShowS)
-> (SimpleType -> String)
-> ([SimpleType] -> ShowS)
-> Show SimpleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleType] -> ShowS
$cshowList :: [SimpleType] -> ShowS
show :: SimpleType -> String
$cshow :: SimpleType -> String
showsPrec :: Int -> SimpleType -> ShowS
$cshowsPrec :: Int -> SimpleType -> ShowS
Show)

-- | Model min/max restrictions.
data Bound a = Inclusive a | Exclusive a deriving (Typeable (Bound a)
DataType
Constr
Typeable (Bound a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bound a -> c (Bound a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Bound a))
-> (Bound a -> Constr)
-> (Bound a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Bound a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bound a)))
-> ((forall b. Data b => b -> b) -> Bound a -> Bound a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bound a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bound a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bound a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bound a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Bound a -> m (Bound a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bound a -> m (Bound a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Bound a -> m (Bound a))
-> Data (Bound a)
Bound a -> DataType
Bound a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Bound a))
(forall b. Data b => b -> b) -> Bound a -> Bound a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bound a -> c (Bound a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bound a)
forall a. Data a => Typeable (Bound a)
forall a. Data a => Bound a -> DataType
forall a. Data a => Bound a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Bound a -> Bound a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Bound a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Bound a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bound a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bound a -> c (Bound a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bound a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bound a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bound a -> u
forall u. (forall d. Data d => d -> u) -> Bound a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bound a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bound a -> c (Bound a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bound a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bound a))
$cExclusive :: Constr
$cInclusive :: Constr
$tBound :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
gmapMp :: (forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
gmapM :: (forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Bound a -> m (Bound a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bound a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Bound a -> u
gmapQ :: (forall d. Data d => d -> u) -> Bound a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Bound a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bound a -> r
gmapT :: (forall b. Data b => b -> b) -> Bound a -> Bound a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Bound a -> Bound a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bound a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bound a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Bound a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bound a))
dataTypeOf :: Bound a -> DataType
$cdataTypeOf :: forall a. Data a => Bound a -> DataType
toConstr :: Bound a -> Constr
$ctoConstr :: forall a. Data a => Bound a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bound a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bound a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bound a -> c (Bound a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bound a -> c (Bound a)
$cp1Data :: forall a. Data a => Typeable (Bound a)
Data,Typeable,Bound a -> Bound a -> Bool
(Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bool) -> Eq (Bound a)
forall a. Eq a => Bound a -> Bound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bound a -> Bound a -> Bool
$c/= :: forall a. Eq a => Bound a -> Bound a -> Bool
== :: Bound a -> Bound a -> Bool
$c== :: forall a. Eq a => Bound a -> Bound a -> Bool
Eq,Int -> Bound a -> ShowS
[Bound a] -> ShowS
Bound a -> String
(Int -> Bound a -> ShowS)
-> (Bound a -> String) -> ([Bound a] -> ShowS) -> Show (Bound a)
forall a. Show a => Int -> Bound a -> ShowS
forall a. Show a => [Bound a] -> ShowS
forall a. Show a => Bound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound a] -> ShowS
$cshowList :: forall a. Show a => [Bound a] -> ShowS
show :: Bound a -> String
$cshow :: forall a. Show a => Bound a -> String
showsPrec :: Int -> Bound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bound a -> ShowS
Show,a -> Bound b -> Bound a
(a -> b) -> Bound a -> Bound b
(forall a b. (a -> b) -> Bound a -> Bound b)
-> (forall a b. a -> Bound b -> Bound a) -> Functor Bound
forall a b. a -> Bound b -> Bound a
forall a b. (a -> b) -> Bound a -> Bound b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bound b -> Bound a
$c<$ :: forall a b. a -> Bound b -> Bound a
fmap :: (a -> b) -> Bound a -> Bound b
$cfmap :: forall a b. (a -> b) -> Bound a -> Bound b
Functor,Eq (Bound a)
Eq (Bound a)
-> (Bound a -> Bound a -> Ordering)
-> (Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bool)
-> (Bound a -> Bound a -> Bound a)
-> (Bound a -> Bound a -> Bound a)
-> Ord (Bound a)
Bound a -> Bound a -> Bool
Bound a -> Bound a -> Ordering
Bound a -> Bound a -> Bound a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Bound a)
forall a. Ord a => Bound a -> Bound a -> Bool
forall a. Ord a => Bound a -> Bound a -> Ordering
forall a. Ord a => Bound a -> Bound a -> Bound a
min :: Bound a -> Bound a -> Bound a
$cmin :: forall a. Ord a => Bound a -> Bound a -> Bound a
max :: Bound a -> Bound a -> Bound a
$cmax :: forall a. Ord a => Bound a -> Bound a -> Bound a
>= :: Bound a -> Bound a -> Bool
$c>= :: forall a. Ord a => Bound a -> Bound a -> Bool
> :: Bound a -> Bound a -> Bool
$c> :: forall a. Ord a => Bound a -> Bound a -> Bool
<= :: Bound a -> Bound a -> Bool
$c<= :: forall a. Ord a => Bound a -> Bound a -> Bool
< :: Bound a -> Bound a -> Bool
$c< :: forall a. Ord a => Bound a -> Bound a -> Bool
compare :: Bound a -> Bound a -> Ordering
$ccompare :: forall a. Ord a => Bound a -> Bound a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Bound a)
Ord)

-- | simple type restriction production.
data SimpleRestriction =
    SimpleRestriction {
      SimpleRestriction -> Ref SimpleType
_simpleRestrictBase :: !(Ref SimpleType)
    , SimpleRestriction -> [String]
_simpleRestrictEnums :: ![String]
    , SimpleRestriction -> Maybe (Bound String)
_simpleRestrictMin :: !(Maybe (Bound String))
    , SimpleRestriction -> Maybe (Bound String)
_simpleRestrictMax :: !(Maybe (Bound String))
    , SimpleRestriction -> Maybe String
_simpleRestrictPattern :: !(Maybe String) }
    deriving (Typeable SimpleRestriction
DataType
Constr
Typeable SimpleRestriction
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SimpleRestriction
    -> c SimpleRestriction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SimpleRestriction)
-> (SimpleRestriction -> Constr)
-> (SimpleRestriction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SimpleRestriction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SimpleRestriction))
-> ((forall b. Data b => b -> b)
    -> SimpleRestriction -> SimpleRestriction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SimpleRestriction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SimpleRestriction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SimpleRestriction -> m SimpleRestriction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SimpleRestriction -> m SimpleRestriction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SimpleRestriction -> m SimpleRestriction)
-> Data SimpleRestriction
SimpleRestriction -> DataType
SimpleRestriction -> Constr
(forall b. Data b => b -> b)
-> SimpleRestriction -> SimpleRestriction
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleRestriction -> c SimpleRestriction
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleRestriction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SimpleRestriction -> u
forall u. (forall d. Data d => d -> u) -> SimpleRestriction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleRestriction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleRestriction -> c SimpleRestriction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleRestriction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleRestriction)
$cSimpleRestriction :: Constr
$tSimpleRestriction :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
gmapMp :: (forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
gmapM :: (forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SimpleRestriction -> m SimpleRestriction
gmapQi :: Int -> (forall d. Data d => d -> u) -> SimpleRestriction -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SimpleRestriction -> u
gmapQ :: (forall d. Data d => d -> u) -> SimpleRestriction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleRestriction -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleRestriction -> r
gmapT :: (forall b. Data b => b -> b)
-> SimpleRestriction -> SimpleRestriction
$cgmapT :: (forall b. Data b => b -> b)
-> SimpleRestriction -> SimpleRestriction
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleRestriction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleRestriction)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SimpleRestriction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleRestriction)
dataTypeOf :: SimpleRestriction -> DataType
$cdataTypeOf :: SimpleRestriction -> DataType
toConstr :: SimpleRestriction -> Constr
$ctoConstr :: SimpleRestriction -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleRestriction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleRestriction
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleRestriction -> c SimpleRestriction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleRestriction -> c SimpleRestriction
$cp1Data :: Typeable SimpleRestriction
Data,Typeable,SimpleRestriction -> SimpleRestriction -> Bool
(SimpleRestriction -> SimpleRestriction -> Bool)
-> (SimpleRestriction -> SimpleRestriction -> Bool)
-> Eq SimpleRestriction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleRestriction -> SimpleRestriction -> Bool
$c/= :: SimpleRestriction -> SimpleRestriction -> Bool
== :: SimpleRestriction -> SimpleRestriction -> Bool
$c== :: SimpleRestriction -> SimpleRestriction -> Bool
Eq,Int -> SimpleRestriction -> ShowS
[SimpleRestriction] -> ShowS
SimpleRestriction -> String
(Int -> SimpleRestriction -> ShowS)
-> (SimpleRestriction -> String)
-> ([SimpleRestriction] -> ShowS)
-> Show SimpleRestriction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleRestriction] -> ShowS
$cshowList :: [SimpleRestriction] -> ShowS
show :: SimpleRestriction -> String
$cshow :: SimpleRestriction -> String
showsPrec :: Int -> SimpleRestriction -> ShowS
$cshowsPrec :: Int -> SimpleRestriction -> ShowS
Show)


-- | Simple type union production.
data Union =
    Union {
      Union -> [Ref SimpleType]
_unionMemberTypes :: ![Ref SimpleType]
    , Union -> [SimpleType]
_unionSimpleTypes :: ![SimpleType] }
    deriving (Typeable Union
DataType
Constr
Typeable Union
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Union -> c Union)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Union)
-> (Union -> Constr)
-> (Union -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Union))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Union))
-> ((forall b. Data b => b -> b) -> Union -> Union)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r)
-> (forall u. (forall d. Data d => d -> u) -> Union -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Union -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Union -> m Union)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Union -> m Union)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Union -> m Union)
-> Data Union
Union -> DataType
Union -> Constr
(forall b. Data b => b -> b) -> Union -> Union
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Union -> c Union
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Union
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Union -> u
forall u. (forall d. Data d => d -> u) -> Union -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Union -> m Union
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Union -> m Union
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Union
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Union -> c Union
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Union)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Union)
$cUnion :: Constr
$tUnion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Union -> m Union
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Union -> m Union
gmapMp :: (forall d. Data d => d -> m d) -> Union -> m Union
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Union -> m Union
gmapM :: (forall d. Data d => d -> m d) -> Union -> m Union
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Union -> m Union
gmapQi :: Int -> (forall d. Data d => d -> u) -> Union -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Union -> u
gmapQ :: (forall d. Data d => d -> u) -> Union -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Union -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Union -> r
gmapT :: (forall b. Data b => b -> b) -> Union -> Union
$cgmapT :: (forall b. Data b => b -> b) -> Union -> Union
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Union)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Union)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Union)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Union)
dataTypeOf :: Union -> DataType
$cdataTypeOf :: Union -> DataType
toConstr :: Union -> Constr
$ctoConstr :: Union -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Union
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Union
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Union -> c Union
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Union -> c Union
$cp1Data :: Typeable Union
Data,Typeable,Union -> Union -> Bool
(Union -> Union -> Bool) -> (Union -> Union -> Bool) -> Eq Union
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Union -> Union -> Bool
$c/= :: Union -> Union -> Bool
== :: Union -> Union -> Bool
$c== :: Union -> Union -> Bool
Eq,Int -> Union -> ShowS
[Union] -> ShowS
Union -> String
(Int -> Union -> ShowS)
-> (Union -> String) -> ([Union] -> ShowS) -> Show Union
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Union] -> ShowS
$cshowList :: [Union] -> ShowS
show :: Union -> String
$cshow :: Union -> String
showsPrec :: Int -> Union -> ShowS
$cshowsPrec :: Int -> Union -> ShowS
Show)

-- | XSD attribute production.
data Attribute =
    AttributeType {
      Attribute -> QN
_attrName :: !QN,
      Attribute -> Ref SimpleType
_attrType :: !(Ref SimpleType),
      Attribute -> Use
_attrUse :: !Use,
      Attribute -> Maybe String
_attrDefault :: !(Maybe String) } |
    AttributeRef {
      Attribute -> Ref Attribute
_attrRef :: !(Ref Attribute),
      _attrUse :: !Use,
      _attrDefault :: !(Maybe String) } |
    AttributeSimpleType {
      _attrName :: !QN,
      Attribute -> SimpleType
_attrSimpleType :: SimpleType
    }
    deriving (Typeable Attribute
DataType
Constr
Typeable Attribute
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Attribute -> c Attribute)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Attribute)
-> (Attribute -> Constr)
-> (Attribute -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Attribute))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute))
-> ((forall b. Data b => b -> b) -> Attribute -> Attribute)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Attribute -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Attribute -> r)
-> (forall u. (forall d. Data d => d -> u) -> Attribute -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Attribute -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attribute -> m Attribute)
-> Data Attribute
Attribute -> DataType
Attribute -> Constr
(forall b. Data b => b -> b) -> Attribute -> Attribute
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attribute)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
$cAttributeSimpleType :: Constr
$cAttributeRef :: Constr
$cAttributeType :: Constr
$tAttribute :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapMp :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapM :: (forall d. Data d => d -> m d) -> Attribute -> m Attribute
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attribute -> m Attribute
gmapQi :: Int -> (forall d. Data d => d -> u) -> Attribute -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attribute -> u
gmapQ :: (forall d. Data d => d -> u) -> Attribute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attribute -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attribute -> r
gmapT :: (forall b. Data b => b -> b) -> Attribute -> Attribute
$cgmapT :: (forall b. Data b => b -> b) -> Attribute -> Attribute
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attribute)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Attribute)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attribute)
dataTypeOf :: Attribute -> DataType
$cdataTypeOf :: Attribute -> DataType
toConstr :: Attribute -> Constr
$ctoConstr :: Attribute -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attribute
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attribute -> c Attribute
$cp1Data :: Typeable Attribute
Data,Typeable,Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq,Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

-- | XSD "use" values.
data Use = Required | Optional | Prohibited deriving (Typeable Use
DataType
Constr
Typeable Use
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Use -> c Use)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Use)
-> (Use -> Constr)
-> (Use -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Use))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Use))
-> ((forall b. Data b => b -> b) -> Use -> Use)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r)
-> (forall u. (forall d. Data d => d -> u) -> Use -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Use -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Use -> m Use)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Use -> m Use)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Use -> m Use)
-> Data Use
Use -> DataType
Use -> Constr
(forall b. Data b => b -> b) -> Use -> Use
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Use -> c Use
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Use
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Use -> u
forall u. (forall d. Data d => d -> u) -> Use -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Use -> m Use
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Use -> m Use
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Use
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Use -> c Use
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Use)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Use)
$cProhibited :: Constr
$cOptional :: Constr
$cRequired :: Constr
$tUse :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Use -> m Use
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Use -> m Use
gmapMp :: (forall d. Data d => d -> m d) -> Use -> m Use
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Use -> m Use
gmapM :: (forall d. Data d => d -> m d) -> Use -> m Use
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Use -> m Use
gmapQi :: Int -> (forall d. Data d => d -> u) -> Use -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Use -> u
gmapQ :: (forall d. Data d => d -> u) -> Use -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Use -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Use -> r
gmapT :: (forall b. Data b => b -> b) -> Use -> Use
$cgmapT :: (forall b. Data b => b -> b) -> Use -> Use
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Use)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Use)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Use)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Use)
dataTypeOf :: Use -> DataType
$cdataTypeOf :: Use -> DataType
toConstr :: Use -> Constr
$ctoConstr :: Use -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Use
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Use
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Use -> c Use
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Use -> c Use
$cp1Data :: Typeable Use
Data,Typeable,Use -> Use -> Bool
(Use -> Use -> Bool) -> (Use -> Use -> Bool) -> Eq Use
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Use -> Use -> Bool
$c/= :: Use -> Use -> Bool
== :: Use -> Use -> Bool
$c== :: Use -> Use -> Bool
Eq,Int -> Use -> ShowS
[Use] -> ShowS
Use -> String
(Int -> Use -> ShowS)
-> (Use -> String) -> ([Use] -> ShowS) -> Show Use
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Use] -> ShowS
$cshowList :: [Use] -> ShowS
show :: Use -> String
$cshow :: Use -> String
showsPrec :: Int -> Use -> ShowS
$cshowsPrec :: Int -> Use -> ShowS
Show)

-- | XSD attribute-group production.
data AttributeGroup =
    AttributeGroup {
      AttributeGroup -> QN
_attrGroupName :: !QN
    , AttributeGroup -> Attributes
_attrGroupAttributes :: !Attributes
    , AttributeGroup -> Maybe Documentation
_attrGroupDoc :: Maybe Documentation } |
    AttributeGroupRef {
      AttributeGroup -> Ref AttributeGroup
_attrGroupRef :: !(Ref AttributeGroup)
    }
    deriving (Typeable AttributeGroup
DataType
Constr
Typeable AttributeGroup
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AttributeGroup -> c AttributeGroup)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AttributeGroup)
-> (AttributeGroup -> Constr)
-> (AttributeGroup -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AttributeGroup))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AttributeGroup))
-> ((forall b. Data b => b -> b)
    -> AttributeGroup -> AttributeGroup)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AttributeGroup -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AttributeGroup -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AttributeGroup -> m AttributeGroup)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AttributeGroup -> m AttributeGroup)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AttributeGroup -> m AttributeGroup)
-> Data AttributeGroup
AttributeGroup -> DataType
AttributeGroup -> Constr
(forall b. Data b => b -> b) -> AttributeGroup -> AttributeGroup
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeGroup -> c AttributeGroup
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeGroup
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AttributeGroup -> u
forall u. (forall d. Data d => d -> u) -> AttributeGroup -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeGroup
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeGroup -> c AttributeGroup
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeGroup)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeGroup)
$cAttributeGroupRef :: Constr
$cAttributeGroup :: Constr
$tAttributeGroup :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
gmapMp :: (forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
gmapM :: (forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AttributeGroup -> m AttributeGroup
gmapQi :: Int -> (forall d. Data d => d -> u) -> AttributeGroup -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AttributeGroup -> u
gmapQ :: (forall d. Data d => d -> u) -> AttributeGroup -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AttributeGroup -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AttributeGroup -> r
gmapT :: (forall b. Data b => b -> b) -> AttributeGroup -> AttributeGroup
$cgmapT :: (forall b. Data b => b -> b) -> AttributeGroup -> AttributeGroup
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeGroup)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AttributeGroup)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AttributeGroup)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AttributeGroup)
dataTypeOf :: AttributeGroup -> DataType
$cdataTypeOf :: AttributeGroup -> DataType
toConstr :: AttributeGroup -> Constr
$ctoConstr :: AttributeGroup -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeGroup
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AttributeGroup
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeGroup -> c AttributeGroup
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AttributeGroup -> c AttributeGroup
$cp1Data :: Typeable AttributeGroup
Data,Typeable,AttributeGroup -> AttributeGroup -> Bool
(AttributeGroup -> AttributeGroup -> Bool)
-> (AttributeGroup -> AttributeGroup -> Bool) -> Eq AttributeGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeGroup -> AttributeGroup -> Bool
$c/= :: AttributeGroup -> AttributeGroup -> Bool
== :: AttributeGroup -> AttributeGroup -> Bool
$c== :: AttributeGroup -> AttributeGroup -> Bool
Eq,Int -> AttributeGroup -> ShowS
[AttributeGroup] -> ShowS
AttributeGroup -> String
(Int -> AttributeGroup -> ShowS)
-> (AttributeGroup -> String)
-> ([AttributeGroup] -> ShowS)
-> Show AttributeGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeGroup] -> ShowS
$cshowList :: [AttributeGroup] -> ShowS
show :: AttributeGroup -> String
$cshow :: AttributeGroup -> String
showsPrec :: Int -> AttributeGroup -> ShowS
$cshowsPrec :: Int -> AttributeGroup -> ShowS
Show)


-- | Convenience grouping of attributes and attribute groups, which
-- are always showing up together in xsd.
data Attributes =
    Attributes {
      Attributes -> [Attribute]
_attrsAttributes :: ![Attribute],
      Attributes -> [AttributeGroup]
_attrsAttributeGroups :: ![AttributeGroup]
    } deriving (Typeable Attributes
DataType
Constr
Typeable Attributes
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Attributes -> c Attributes)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Attributes)
-> (Attributes -> Constr)
-> (Attributes -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Attributes))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Attributes))
-> ((forall b. Data b => b -> b) -> Attributes -> Attributes)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Attributes -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Attributes -> r)
-> (forall u. (forall d. Data d => d -> u) -> Attributes -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Attributes -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Attributes -> m Attributes)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attributes -> m Attributes)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attributes -> m Attributes)
-> Data Attributes
Attributes -> DataType
Attributes -> Constr
(forall b. Data b => b -> b) -> Attributes -> Attributes
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attributes -> c Attributes
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attributes
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Attributes -> u
forall u. (forall d. Data d => d -> u) -> Attributes -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attributes -> m Attributes
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attributes -> m Attributes
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attributes
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attributes -> c Attributes
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attributes)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attributes)
$cAttributes :: Constr
$tAttributes :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Attributes -> m Attributes
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attributes -> m Attributes
gmapMp :: (forall d. Data d => d -> m d) -> Attributes -> m Attributes
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attributes -> m Attributes
gmapM :: (forall d. Data d => d -> m d) -> Attributes -> m Attributes
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attributes -> m Attributes
gmapQi :: Int -> (forall d. Data d => d -> u) -> Attributes -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attributes -> u
gmapQ :: (forall d. Data d => d -> u) -> Attributes -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attributes -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attributes -> r
gmapT :: (forall b. Data b => b -> b) -> Attributes -> Attributes
$cgmapT :: (forall b. Data b => b -> b) -> Attributes -> Attributes
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attributes)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attributes)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Attributes)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attributes)
dataTypeOf :: Attributes -> DataType
$cdataTypeOf :: Attributes -> DataType
toConstr :: Attributes -> Constr
$ctoConstr :: Attributes -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attributes
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attributes
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attributes -> c Attributes
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attributes -> c Attributes
$cp1Data :: Typeable Attributes
Data,Typeable,Attributes -> Attributes -> Bool
(Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool) -> Eq Attributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq,Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
(Int -> Attributes -> ShowS)
-> (Attributes -> String)
-> ([Attributes] -> ShowS)
-> Show Attributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show)

-- | "occurs-min" and "occurs-max"
data Occurs =
    Occurs {
      Occurs -> Maybe String
_occursMin :: !(Maybe String)
    , Occurs -> Maybe String
_occursMax :: !(Maybe String)
} deriving (Typeable Occurs
DataType
Constr
Typeable Occurs
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Occurs -> c Occurs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Occurs)
-> (Occurs -> Constr)
-> (Occurs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Occurs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Occurs))
-> ((forall b. Data b => b -> b) -> Occurs -> Occurs)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Occurs -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Occurs -> r)
-> (forall u. (forall d. Data d => d -> u) -> Occurs -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Occurs -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Occurs -> m Occurs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Occurs -> m Occurs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Occurs -> m Occurs)
-> Data Occurs
Occurs -> DataType
Occurs -> Constr
(forall b. Data b => b -> b) -> Occurs -> Occurs
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Occurs -> c Occurs
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Occurs
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Occurs -> u
forall u. (forall d. Data d => d -> u) -> Occurs -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Occurs -> m Occurs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Occurs -> m Occurs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Occurs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Occurs -> c Occurs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Occurs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Occurs)
$cOccurs :: Constr
$tOccurs :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Occurs -> m Occurs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Occurs -> m Occurs
gmapMp :: (forall d. Data d => d -> m d) -> Occurs -> m Occurs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Occurs -> m Occurs
gmapM :: (forall d. Data d => d -> m d) -> Occurs -> m Occurs
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Occurs -> m Occurs
gmapQi :: Int -> (forall d. Data d => d -> u) -> Occurs -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Occurs -> u
gmapQ :: (forall d. Data d => d -> u) -> Occurs -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Occurs -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Occurs -> r
gmapT :: (forall b. Data b => b -> b) -> Occurs -> Occurs
$cgmapT :: (forall b. Data b => b -> b) -> Occurs -> Occurs
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Occurs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Occurs)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Occurs)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Occurs)
dataTypeOf :: Occurs -> DataType
$cdataTypeOf :: Occurs -> DataType
toConstr :: Occurs -> Constr
$ctoConstr :: Occurs -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Occurs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Occurs
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Occurs -> c Occurs
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Occurs -> c Occurs
$cp1Data :: Typeable Occurs
Data,Typeable,Occurs -> Occurs -> Bool
(Occurs -> Occurs -> Bool)
-> (Occurs -> Occurs -> Bool) -> Eq Occurs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Occurs -> Occurs -> Bool
$c/= :: Occurs -> Occurs -> Bool
== :: Occurs -> Occurs -> Bool
$c== :: Occurs -> Occurs -> Bool
Eq,Int -> Occurs -> ShowS
[Occurs] -> ShowS
Occurs -> String
(Int -> Occurs -> ShowS)
-> (Occurs -> String) -> ([Occurs] -> ShowS) -> Show Occurs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurs] -> ShowS
$cshowList :: [Occurs] -> ShowS
show :: Occurs -> String
$cshow :: Occurs -> String
showsPrec :: Int -> Occurs -> ShowS
$cshowsPrec :: Int -> Occurs -> ShowS
Show)

-- | XSD element production.
data Element =
    ElementType {
      Element -> QN
_elementName :: !QN
    , Element -> Ref (Either ComplexType SimpleType)
_elementType :: !(Ref (Either ComplexType SimpleType))
    , Element -> Occurs
_elementOccurs :: !Occurs
    , Element -> Maybe Documentation
_elementDoc :: Maybe Documentation } |
    ElementSimple {
      _elementName :: !QN
    , Element -> SimpleType
_elementSimple :: !SimpleType
    , _elementOccurs :: !Occurs
    , _elementDoc :: Maybe Documentation } |
    ElementComplex {
      _elementName :: !QN
    , Element -> ComplexType
_elementComplex :: !ComplexType
    , _elementOccurs :: !Occurs
    , _elementDoc :: Maybe Documentation } |
    ElementRef {
      Element -> Ref Element
_elementRef :: !(Ref Element)
    , _elementOccurs :: !Occurs }
    deriving (Typeable Element
DataType
Constr
Typeable Element
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Element -> c Element)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Element)
-> (Element -> Constr)
-> (Element -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Element))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element))
-> ((forall b. Data b => b -> b) -> Element -> Element)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Element -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Element -> r)
-> (forall u. (forall d. Data d => d -> u) -> Element -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Element -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Element -> m Element)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Element -> m Element)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Element -> m Element)
-> Data Element
Element -> DataType
Element -> Constr
(forall b. Data b => b -> b) -> Element -> Element
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
forall u. (forall d. Data d => d -> u) -> Element -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
$cElementRef :: Constr
$cElementComplex :: Constr
$cElementSimple :: Constr
$cElementType :: Constr
$tElement :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapMp :: (forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapM :: (forall d. Data d => d -> m d) -> Element -> m Element
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapQi :: Int -> (forall d. Data d => d -> u) -> Element -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
gmapQ :: (forall d. Data d => d -> u) -> Element -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapT :: (forall b. Data b => b -> b) -> Element -> Element
$cgmapT :: (forall b. Data b => b -> b) -> Element -> Element
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Element)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
dataTypeOf :: Element -> DataType
$cdataTypeOf :: Element -> DataType
toConstr :: Element -> Constr
$ctoConstr :: Element -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
$cp1Data :: Typeable Element
Data,Typeable,Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq,Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show)


-- | XSD complexType production.
data ComplexType =
    ComplexTypeSimple {
      ComplexType -> Maybe QN
_complexTypeName :: !(Maybe QN)
    , ComplexType -> SimpleContent
_complexSimpleContent :: !SimpleContent
    , ComplexType -> Maybe Documentation
_complexTypeDoc :: Maybe Documentation } |
    ComplexTypeComplex {
      _complexTypeName :: !(Maybe QN)
    , ComplexType -> ComplexContent
_complexComplexContent :: !ComplexContent
    , _complexTypeDoc :: Maybe Documentation } |
    ComplexTypeCompositor {
      _complexTypeName :: !(Maybe QN)
    , ComplexType -> Maybe Compositor
_complexCompositor :: !(Maybe Compositor)
    , ComplexType -> Attributes
_complexAttributes :: !Attributes
    , _complexTypeDoc :: Maybe Documentation }
    deriving (Typeable ComplexType
DataType
Constr
Typeable ComplexType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ComplexType -> c ComplexType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ComplexType)
-> (ComplexType -> Constr)
-> (ComplexType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ComplexType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ComplexType))
-> ((forall b. Data b => b -> b) -> ComplexType -> ComplexType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ComplexType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ComplexType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ComplexType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ComplexType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType)
-> Data ComplexType
ComplexType -> DataType
ComplexType -> Constr
(forall b. Data b => b -> b) -> ComplexType -> ComplexType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexType -> c ComplexType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ComplexType -> u
forall u. (forall d. Data d => d -> u) -> ComplexType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexType -> c ComplexType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComplexType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexType)
$cComplexTypeCompositor :: Constr
$cComplexTypeComplex :: Constr
$cComplexTypeSimple :: Constr
$tComplexType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
gmapMp :: (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
gmapM :: (forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ComplexType -> m ComplexType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ComplexType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ComplexType -> u
gmapQ :: (forall d. Data d => d -> u) -> ComplexType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ComplexType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexType -> r
gmapT :: (forall b. Data b => b -> b) -> ComplexType -> ComplexType
$cgmapT :: (forall b. Data b => b -> b) -> ComplexType -> ComplexType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ComplexType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComplexType)
dataTypeOf :: ComplexType -> DataType
$cdataTypeOf :: ComplexType -> DataType
toConstr :: ComplexType -> Constr
$ctoConstr :: ComplexType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexType -> c ComplexType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexType -> c ComplexType
$cp1Data :: Typeable ComplexType
Data,Typeable,ComplexType -> ComplexType -> Bool
(ComplexType -> ComplexType -> Bool)
-> (ComplexType -> ComplexType -> Bool) -> Eq ComplexType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplexType -> ComplexType -> Bool
$c/= :: ComplexType -> ComplexType -> Bool
== :: ComplexType -> ComplexType -> Bool
$c== :: ComplexType -> ComplexType -> Bool
Eq,Int -> ComplexType -> ShowS
[ComplexType] -> ShowS
ComplexType -> String
(Int -> ComplexType -> ShowS)
-> (ComplexType -> String)
-> ([ComplexType] -> ShowS)
-> Show ComplexType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComplexType] -> ShowS
$cshowList :: [ComplexType] -> ShowS
show :: ComplexType -> String
$cshow :: ComplexType -> String
showsPrec :: Int -> ComplexType -> ShowS
$cshowsPrec :: Int -> ComplexType -> ShowS
Show)

-- | simpleContent under a complex type.
data SimpleContent =
    SimpleContentExtension {
      SimpleContent -> Ref SimpleType
_simpleContentBase :: !(Ref SimpleType)
    , SimpleContent -> Attributes
_simpleContentAttributes :: !Attributes
    }
   deriving (Typeable SimpleContent
DataType
Constr
Typeable SimpleContent
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SimpleContent -> c SimpleContent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SimpleContent)
-> (SimpleContent -> Constr)
-> (SimpleContent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SimpleContent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SimpleContent))
-> ((forall b. Data b => b -> b) -> SimpleContent -> SimpleContent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleContent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SimpleContent -> r)
-> (forall u. (forall d. Data d => d -> u) -> SimpleContent -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SimpleContent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent)
-> Data SimpleContent
SimpleContent -> DataType
SimpleContent -> Constr
(forall b. Data b => b -> b) -> SimpleContent -> SimpleContent
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleContent -> c SimpleContent
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleContent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SimpleContent -> u
forall u. (forall d. Data d => d -> u) -> SimpleContent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleContent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleContent -> c SimpleContent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleContent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleContent)
$cSimpleContentExtension :: Constr
$tSimpleContent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
gmapMp :: (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
gmapM :: (forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SimpleContent -> m SimpleContent
gmapQi :: Int -> (forall d. Data d => d -> u) -> SimpleContent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SimpleContent -> u
gmapQ :: (forall d. Data d => d -> u) -> SimpleContent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SimpleContent -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SimpleContent -> r
gmapT :: (forall b. Data b => b -> b) -> SimpleContent -> SimpleContent
$cgmapT :: (forall b. Data b => b -> b) -> SimpleContent -> SimpleContent
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleContent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SimpleContent)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SimpleContent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SimpleContent)
dataTypeOf :: SimpleContent -> DataType
$cdataTypeOf :: SimpleContent -> DataType
toConstr :: SimpleContent -> Constr
$ctoConstr :: SimpleContent -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleContent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SimpleContent
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleContent -> c SimpleContent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SimpleContent -> c SimpleContent
$cp1Data :: Typeable SimpleContent
Data,Typeable,SimpleContent -> SimpleContent -> Bool
(SimpleContent -> SimpleContent -> Bool)
-> (SimpleContent -> SimpleContent -> Bool) -> Eq SimpleContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleContent -> SimpleContent -> Bool
$c/= :: SimpleContent -> SimpleContent -> Bool
== :: SimpleContent -> SimpleContent -> Bool
$c== :: SimpleContent -> SimpleContent -> Bool
Eq,Int -> SimpleContent -> ShowS
[SimpleContent] -> ShowS
SimpleContent -> String
(Int -> SimpleContent -> ShowS)
-> (SimpleContent -> String)
-> ([SimpleContent] -> ShowS)
-> Show SimpleContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleContent] -> ShowS
$cshowList :: [SimpleContent] -> ShowS
show :: SimpleContent -> String
$cshow :: SimpleContent -> String
showsPrec :: Int -> SimpleContent -> ShowS
$cshowsPrec :: Int -> SimpleContent -> ShowS
Show)


-- | complexContent under a complex type.
-- TODO: restrictions
data ComplexContent =
    ComplexContentExtension {
      ComplexContent -> Ref ComplexType
_complexContentBase :: !(Ref ComplexType)
    , ComplexContent -> Attributes
_complexContentAttributes :: !Attributes
    , ComplexContent -> Maybe Compositor
_complexContentCompositor :: Maybe Compositor
    } deriving (Typeable ComplexContent
DataType
Constr
Typeable ComplexContent
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ComplexContent -> c ComplexContent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ComplexContent)
-> (ComplexContent -> Constr)
-> (ComplexContent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ComplexContent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ComplexContent))
-> ((forall b. Data b => b -> b)
    -> ComplexContent -> ComplexContent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ComplexContent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ComplexContent -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ComplexContent -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ComplexContent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ComplexContent -> m ComplexContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComplexContent -> m ComplexContent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComplexContent -> m ComplexContent)
-> Data ComplexContent
ComplexContent -> DataType
ComplexContent -> Constr
(forall b. Data b => b -> b) -> ComplexContent -> ComplexContent
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexContent -> c ComplexContent
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexContent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ComplexContent -> u
forall u. (forall d. Data d => d -> u) -> ComplexContent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexContent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexContent -> c ComplexContent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComplexContent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexContent)
$cComplexContentExtension :: Constr
$tComplexContent :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
gmapMp :: (forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
gmapM :: (forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComplexContent -> m ComplexContent
gmapQi :: Int -> (forall d. Data d => d -> u) -> ComplexContent -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ComplexContent -> u
gmapQ :: (forall d. Data d => d -> u) -> ComplexContent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ComplexContent -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ComplexContent -> r
gmapT :: (forall b. Data b => b -> b) -> ComplexContent -> ComplexContent
$cgmapT :: (forall b. Data b => b -> b) -> ComplexContent -> ComplexContent
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexContent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ComplexContent)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ComplexContent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ComplexContent)
dataTypeOf :: ComplexContent -> DataType
$cdataTypeOf :: ComplexContent -> DataType
toConstr :: ComplexContent -> Constr
$ctoConstr :: ComplexContent -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexContent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ComplexContent
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexContent -> c ComplexContent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ComplexContent -> c ComplexContent
$cp1Data :: Typeable ComplexContent
Data,Typeable,ComplexContent -> ComplexContent -> Bool
(ComplexContent -> ComplexContent -> Bool)
-> (ComplexContent -> ComplexContent -> Bool) -> Eq ComplexContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplexContent -> ComplexContent -> Bool
$c/= :: ComplexContent -> ComplexContent -> Bool
== :: ComplexContent -> ComplexContent -> Bool
$c== :: ComplexContent -> ComplexContent -> Bool
Eq,Int -> ComplexContent -> ShowS
[ComplexContent] -> ShowS
ComplexContent -> String
(Int -> ComplexContent -> ShowS)
-> (ComplexContent -> String)
-> ([ComplexContent] -> ShowS)
-> Show ComplexContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComplexContent] -> ShowS
$cshowList :: [ComplexContent] -> ShowS
show :: ComplexContent -> String
$cshow :: ComplexContent -> String
showsPrec :: Int -> ComplexContent -> ShowS
$cshowsPrec :: Int -> ComplexContent -> ShowS
Show)

-- | Compositors.
data Compositor =
    CompositorGroup { Compositor -> Group
_compGroup :: !Group } |
    CompositorChoice { Compositor -> Choice
_compChoice :: !Choice } |
    CompositorSequence { Compositor -> Sequence
_compSequence :: !Sequence }
    deriving (Typeable Compositor
DataType
Constr
Typeable Compositor
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Compositor -> c Compositor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Compositor)
-> (Compositor -> Constr)
-> (Compositor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Compositor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Compositor))
-> ((forall b. Data b => b -> b) -> Compositor -> Compositor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Compositor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Compositor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Compositor -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Compositor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Compositor -> m Compositor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Compositor -> m Compositor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Compositor -> m Compositor)
-> Data Compositor
Compositor -> DataType
Compositor -> Constr
(forall b. Data b => b -> b) -> Compositor -> Compositor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Compositor -> c Compositor
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Compositor
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Compositor -> u
forall u. (forall d. Data d => d -> u) -> Compositor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Compositor -> m Compositor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Compositor -> m Compositor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Compositor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Compositor -> c Compositor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Compositor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Compositor)
$cCompositorSequence :: Constr
$cCompositorChoice :: Constr
$cCompositorGroup :: Constr
$tCompositor :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Compositor -> m Compositor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Compositor -> m Compositor
gmapMp :: (forall d. Data d => d -> m d) -> Compositor -> m Compositor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Compositor -> m Compositor
gmapM :: (forall d. Data d => d -> m d) -> Compositor -> m Compositor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Compositor -> m Compositor
gmapQi :: Int -> (forall d. Data d => d -> u) -> Compositor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Compositor -> u
gmapQ :: (forall d. Data d => d -> u) -> Compositor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Compositor -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Compositor -> r
gmapT :: (forall b. Data b => b -> b) -> Compositor -> Compositor
$cgmapT :: (forall b. Data b => b -> b) -> Compositor -> Compositor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Compositor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Compositor)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Compositor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Compositor)
dataTypeOf :: Compositor -> DataType
$cdataTypeOf :: Compositor -> DataType
toConstr :: Compositor -> Constr
$ctoConstr :: Compositor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Compositor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Compositor
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Compositor -> c Compositor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Compositor -> c Compositor
$cp1Data :: Typeable Compositor
Data,Typeable,Compositor -> Compositor -> Bool
(Compositor -> Compositor -> Bool)
-> (Compositor -> Compositor -> Bool) -> Eq Compositor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compositor -> Compositor -> Bool
$c/= :: Compositor -> Compositor -> Bool
== :: Compositor -> Compositor -> Bool
$c== :: Compositor -> Compositor -> Bool
Eq,Int -> Compositor -> ShowS
[Compositor] -> ShowS
Compositor -> String
(Int -> Compositor -> ShowS)
-> (Compositor -> String)
-> ([Compositor] -> ShowS)
-> Show Compositor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compositor] -> ShowS
$cshowList :: [Compositor] -> ShowS
show :: Compositor -> String
$cshow :: Compositor -> String
showsPrec :: Int -> Compositor -> ShowS
$cshowsPrec :: Int -> Compositor -> ShowS
Show)

-- | XSD "group" production.
data Group =
    GroupChoice {
      Group -> Maybe QN
_groupName :: !(Maybe QN),
      Group -> Occurs
_groupOccurs :: !Occurs,
      Group -> Choice
_groupChoice :: !Choice
    , Group -> Maybe Documentation
_groupDoc :: Maybe Documentation } |
    GroupSequence {
      _groupName :: !(Maybe QN),
      _groupOccurs :: !Occurs,
      Group -> Sequence
_groupSequence :: !Sequence
    , _groupDoc :: Maybe Documentation } |
    GroupRef {
      Group -> Ref Group
_groupRef :: !(Ref Group),
      _groupOccurs :: !Occurs
    } deriving (Typeable Group
DataType
Constr
Typeable Group
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Group -> c Group)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Group)
-> (Group -> Constr)
-> (Group -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Group))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Group))
-> ((forall b. Data b => b -> b) -> Group -> Group)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r)
-> (forall u. (forall d. Data d => d -> u) -> Group -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Group -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Group -> m Group)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Group -> m Group)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Group -> m Group)
-> Data Group
Group -> DataType
Group -> Constr
(forall b. Data b => b -> b) -> Group -> Group
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Group -> c Group
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Group
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Group -> u
forall u. (forall d. Data d => d -> u) -> Group -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Group -> m Group
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Group -> m Group
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Group
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Group -> c Group
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Group)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Group)
$cGroupRef :: Constr
$cGroupSequence :: Constr
$cGroupChoice :: Constr
$tGroup :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Group -> m Group
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Group -> m Group
gmapMp :: (forall d. Data d => d -> m d) -> Group -> m Group
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Group -> m Group
gmapM :: (forall d. Data d => d -> m d) -> Group -> m Group
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Group -> m Group
gmapQi :: Int -> (forall d. Data d => d -> u) -> Group -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Group -> u
gmapQ :: (forall d. Data d => d -> u) -> Group -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Group -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Group -> r
gmapT :: (forall b. Data b => b -> b) -> Group -> Group
$cgmapT :: (forall b. Data b => b -> b) -> Group -> Group
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Group)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Group)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Group)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Group)
dataTypeOf :: Group -> DataType
$cdataTypeOf :: Group -> DataType
toConstr :: Group -> Constr
$ctoConstr :: Group -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Group
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Group
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Group -> c Group
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Group -> c Group
$cp1Data :: Typeable Group
Data,Typeable,Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq,Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show)

-- | Particles.
data Particle =
    PartElement { Particle -> Element
_partElement :: !Element } |
    PartGroup { Particle -> Group
_partGroup :: !Group } |
    PartChoice { Particle -> Choice
_partChoice :: !Choice } |
    PartSequence { Particle -> Sequence
_partSequence :: !Sequence }
    deriving (Typeable Particle
DataType
Constr
Typeable Particle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Particle -> c Particle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Particle)
-> (Particle -> Constr)
-> (Particle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Particle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Particle))
-> ((forall b. Data b => b -> b) -> Particle -> Particle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Particle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Particle -> r)
-> (forall u. (forall d. Data d => d -> u) -> Particle -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Particle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Particle -> m Particle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Particle -> m Particle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Particle -> m Particle)
-> Data Particle
Particle -> DataType
Particle -> Constr
(forall b. Data b => b -> b) -> Particle -> Particle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Particle -> c Particle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Particle
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Particle -> u
forall u. (forall d. Data d => d -> u) -> Particle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Particle -> m Particle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Particle -> m Particle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Particle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Particle -> c Particle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Particle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Particle)
$cPartSequence :: Constr
$cPartChoice :: Constr
$cPartGroup :: Constr
$cPartElement :: Constr
$tParticle :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Particle -> m Particle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Particle -> m Particle
gmapMp :: (forall d. Data d => d -> m d) -> Particle -> m Particle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Particle -> m Particle
gmapM :: (forall d. Data d => d -> m d) -> Particle -> m Particle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Particle -> m Particle
gmapQi :: Int -> (forall d. Data d => d -> u) -> Particle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Particle -> u
gmapQ :: (forall d. Data d => d -> u) -> Particle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Particle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Particle -> r
gmapT :: (forall b. Data b => b -> b) -> Particle -> Particle
$cgmapT :: (forall b. Data b => b -> b) -> Particle -> Particle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Particle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Particle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Particle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Particle)
dataTypeOf :: Particle -> DataType
$cdataTypeOf :: Particle -> DataType
toConstr :: Particle -> Constr
$ctoConstr :: Particle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Particle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Particle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Particle -> c Particle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Particle -> c Particle
$cp1Data :: Typeable Particle
Data,Typeable,Particle -> Particle -> Bool
(Particle -> Particle -> Bool)
-> (Particle -> Particle -> Bool) -> Eq Particle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Particle -> Particle -> Bool
$c/= :: Particle -> Particle -> Bool
== :: Particle -> Particle -> Bool
$c== :: Particle -> Particle -> Bool
Eq,Int -> Particle -> ShowS
[Particle] -> ShowS
Particle -> String
(Int -> Particle -> ShowS)
-> (Particle -> String) -> ([Particle] -> ShowS) -> Show Particle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Particle] -> ShowS
$cshowList :: [Particle] -> ShowS
show :: Particle -> String
$cshow :: Particle -> String
showsPrec :: Int -> Particle -> ShowS
$cshowsPrec :: Int -> Particle -> ShowS
Show)


-- | XSD choice
data Choice =
    Choice {
      Choice -> Occurs
_choiceOccurs :: !Occurs
    , Choice -> [Particle]
_choiceParticles :: ![Particle] }
    deriving (Typeable Choice
DataType
Constr
Typeable Choice
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Choice -> c Choice)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Choice)
-> (Choice -> Constr)
-> (Choice -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Choice))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Choice))
-> ((forall b. Data b => b -> b) -> Choice -> Choice)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Choice -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Choice -> r)
-> (forall u. (forall d. Data d => d -> u) -> Choice -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Choice -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Choice -> m Choice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Choice -> m Choice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Choice -> m Choice)
-> Data Choice
Choice -> DataType
Choice -> Constr
(forall b. Data b => b -> b) -> Choice -> Choice
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Choice -> c Choice
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Choice
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Choice -> u
forall u. (forall d. Data d => d -> u) -> Choice -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Choice -> m Choice
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Choice -> m Choice
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Choice
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Choice -> c Choice
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Choice)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Choice)
$cChoice :: Constr
$tChoice :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Choice -> m Choice
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Choice -> m Choice
gmapMp :: (forall d. Data d => d -> m d) -> Choice -> m Choice
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Choice -> m Choice
gmapM :: (forall d. Data d => d -> m d) -> Choice -> m Choice
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Choice -> m Choice
gmapQi :: Int -> (forall d. Data d => d -> u) -> Choice -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Choice -> u
gmapQ :: (forall d. Data d => d -> u) -> Choice -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Choice -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Choice -> r
gmapT :: (forall b. Data b => b -> b) -> Choice -> Choice
$cgmapT :: (forall b. Data b => b -> b) -> Choice -> Choice
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Choice)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Choice)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Choice)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Choice)
dataTypeOf :: Choice -> DataType
$cdataTypeOf :: Choice -> DataType
toConstr :: Choice -> Constr
$ctoConstr :: Choice -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Choice
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Choice
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Choice -> c Choice
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Choice -> c Choice
$cp1Data :: Typeable Choice
Data,Typeable,Choice -> Choice -> Bool
(Choice -> Choice -> Bool)
-> (Choice -> Choice -> Bool) -> Eq Choice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Choice -> Choice -> Bool
$c/= :: Choice -> Choice -> Bool
== :: Choice -> Choice -> Bool
$c== :: Choice -> Choice -> Bool
Eq,Int -> Choice -> ShowS
[Choice] -> ShowS
Choice -> String
(Int -> Choice -> ShowS)
-> (Choice -> String) -> ([Choice] -> ShowS) -> Show Choice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choice] -> ShowS
$cshowList :: [Choice] -> ShowS
show :: Choice -> String
$cshow :: Choice -> String
showsPrec :: Int -> Choice -> ShowS
$cshowsPrec :: Int -> Choice -> ShowS
Show)

-- | XSD sequence.
data Sequence =
    Sequence {
      Sequence -> Occurs
_sequenceOccurs :: !Occurs
    , Sequence -> [Particle]
_sequenceParticles :: ![Particle] }
    deriving (Typeable Sequence
DataType
Constr
Typeable Sequence
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Sequence -> c Sequence)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Sequence)
-> (Sequence -> Constr)
-> (Sequence -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Sequence))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sequence))
-> ((forall b. Data b => b -> b) -> Sequence -> Sequence)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Sequence -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Sequence -> r)
-> (forall u. (forall d. Data d => d -> u) -> Sequence -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Sequence -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Sequence -> m Sequence)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sequence -> m Sequence)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sequence -> m Sequence)
-> Data Sequence
Sequence -> DataType
Sequence -> Constr
(forall b. Data b => b -> b) -> Sequence -> Sequence
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sequence -> c Sequence
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sequence
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Sequence -> u
forall u. (forall d. Data d => d -> u) -> Sequence -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sequence -> m Sequence
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sequence -> m Sequence
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sequence
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sequence -> c Sequence
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sequence)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sequence)
$cSequence :: Constr
$tSequence :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Sequence -> m Sequence
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sequence -> m Sequence
gmapMp :: (forall d. Data d => d -> m d) -> Sequence -> m Sequence
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sequence -> m Sequence
gmapM :: (forall d. Data d => d -> m d) -> Sequence -> m Sequence
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sequence -> m Sequence
gmapQi :: Int -> (forall d. Data d => d -> u) -> Sequence -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Sequence -> u
gmapQ :: (forall d. Data d => d -> u) -> Sequence -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Sequence -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sequence -> r
gmapT :: (forall b. Data b => b -> b) -> Sequence -> Sequence
$cgmapT :: (forall b. Data b => b -> b) -> Sequence -> Sequence
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sequence)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sequence)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Sequence)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sequence)
dataTypeOf :: Sequence -> DataType
$cdataTypeOf :: Sequence -> DataType
toConstr :: Sequence -> Constr
$ctoConstr :: Sequence -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sequence
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sequence
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sequence -> c Sequence
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sequence -> c Sequence
$cp1Data :: Typeable Sequence
Data,Typeable,Sequence -> Sequence -> Bool
(Sequence -> Sequence -> Bool)
-> (Sequence -> Sequence -> Bool) -> Eq Sequence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sequence -> Sequence -> Bool
$c/= :: Sequence -> Sequence -> Bool
== :: Sequence -> Sequence -> Bool
$c== :: Sequence -> Sequence -> Bool
Eq,Int -> Sequence -> ShowS
[Sequence] -> ShowS
Sequence -> String
(Int -> Sequence -> ShowS)
-> (Sequence -> String) -> ([Sequence] -> ShowS) -> Show Sequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sequence] -> ShowS
$cshowList :: [Sequence] -> ShowS
show :: Sequence -> String
$cshow :: Sequence -> String
showsPrec :: Int -> Sequence -> ShowS
$cshowsPrec :: Int -> Sequence -> ShowS
Show)

-- | Schema type, mapping top-level productions to qnames.
data Schema =
    Schema {
      Schema -> Map QN SimpleType
_simpleTypes :: !(Map QN SimpleType)
    , Schema -> Map QN ComplexType
_complexTypes :: !(Map QN ComplexType)
    , Schema -> Map QN Group
_groups :: !(Map QN Group)
    , Schema -> Map QN AttributeGroup
_attributeGroups :: !(Map QN AttributeGroup)
    , Schema -> Map QN Element
_elements :: !(Map QN Element)
    , Schema -> Map QN Attribute
_attributes :: !(Map QN Attribute)
    } deriving (Typeable Schema
DataType
Constr
Typeable Schema
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Schema -> c Schema)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Schema)
-> (Schema -> Constr)
-> (Schema -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Schema))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Schema))
-> ((forall b. Data b => b -> b) -> Schema -> Schema)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Schema -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Schema -> r)
-> (forall u. (forall d. Data d => d -> u) -> Schema -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Schema -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Schema -> m Schema)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Schema -> m Schema)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Schema -> m Schema)
-> Data Schema
Schema -> DataType
Schema -> Constr
(forall b. Data b => b -> b) -> Schema -> Schema
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Schema -> c Schema
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Schema
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Schema -> u
forall u. (forall d. Data d => d -> u) -> Schema -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Schema -> m Schema
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Schema -> m Schema
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Schema
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Schema -> c Schema
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Schema)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Schema)
$cSchema :: Constr
$tSchema :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Schema -> m Schema
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Schema -> m Schema
gmapMp :: (forall d. Data d => d -> m d) -> Schema -> m Schema
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Schema -> m Schema
gmapM :: (forall d. Data d => d -> m d) -> Schema -> m Schema
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Schema -> m Schema
gmapQi :: Int -> (forall d. Data d => d -> u) -> Schema -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Schema -> u
gmapQ :: (forall d. Data d => d -> u) -> Schema -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Schema -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Schema -> r
gmapT :: (forall b. Data b => b -> b) -> Schema -> Schema
$cgmapT :: (forall b. Data b => b -> b) -> Schema -> Schema
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Schema)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Schema)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Schema)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Schema)
dataTypeOf :: Schema -> DataType
$cdataTypeOf :: Schema -> DataType
toConstr :: Schema -> Constr
$ctoConstr :: Schema -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Schema
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Schema
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Schema -> c Schema
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Schema -> c Schema
$cp1Data :: Typeable Schema
Data,Typeable,Schema -> Schema -> Bool
(Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool) -> Eq Schema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c== :: Schema -> Schema -> Bool
Eq)
instance Show Schema where
    show :: Schema -> String
show (Schema Map QN SimpleType
sts Map QN ComplexType
cts Map QN Group
gs Map QN AttributeGroup
ags Map QN Element
es Map QN Attribute
as) =
        String
"Schema { simpleTypes = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN SimpleType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN SimpleType
sts) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
", complexTypes = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN ComplexType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN ComplexType
cts) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
", groups = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN Group -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN Group
gs) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
", attributeGroups = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN AttributeGroup -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN AttributeGroup
ags) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
", elements = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN Element -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN Element
es) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
", attributes = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map QN Attribute -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map QN Attribute
as) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                     String
"}"

instance Semigroup Schema where
  (Schema Map QN SimpleType
a Map QN ComplexType
b Map QN Group
c Map QN AttributeGroup
d Map QN Element
e Map QN Attribute
f) <> :: Schema -> Schema -> Schema
<> (Schema Map QN SimpleType
g Map QN ComplexType
h Map QN Group
i Map QN AttributeGroup
j Map QN Element
k Map QN Attribute
l) =
        Map QN SimpleType
-> Map QN ComplexType
-> Map QN Group
-> Map QN AttributeGroup
-> Map QN Element
-> Map QN Attribute
-> Schema
Schema (Map QN SimpleType
aMap QN SimpleType -> Map QN SimpleType -> Map QN SimpleType
forall a. Semigroup a => a -> a -> a
<>Map QN SimpleType
g) (Map QN ComplexType
bMap QN ComplexType -> Map QN ComplexType -> Map QN ComplexType
forall a. Semigroup a => a -> a -> a
<>Map QN ComplexType
h) (Map QN Group
cMap QN Group -> Map QN Group -> Map QN Group
forall a. Semigroup a => a -> a -> a
<>Map QN Group
i) (Map QN AttributeGroup
dMap QN AttributeGroup
-> Map QN AttributeGroup -> Map QN AttributeGroup
forall a. Semigroup a => a -> a -> a
<>Map QN AttributeGroup
j) (Map QN Element
eMap QN Element -> Map QN Element -> Map QN Element
forall a. Semigroup a => a -> a -> a
<>Map QN Element
k) (Map QN Attribute
fMap QN Attribute -> Map QN Attribute -> Map QN Attribute
forall a. Semigroup a => a -> a -> a
<>Map QN Attribute
l)

instance Monoid Schema where
    mempty :: Schema
mempty = Map QN SimpleType
-> Map QN ComplexType
-> Map QN Group
-> Map QN AttributeGroup
-> Map QN Element
-> Map QN Attribute
-> Schema
Schema Map QN SimpleType
forall a. Monoid a => a
mempty Map QN ComplexType
forall a. Monoid a => a
mempty Map QN Group
forall a. Monoid a => a
mempty Map QN AttributeGroup
forall a. Monoid a => a
mempty Map QN Element
forall a. Monoid a => a
mempty Map QN Attribute
forall a. Monoid a => a
mempty
    mappend :: Schema -> Schema -> Schema
mappend = Schema -> Schema -> Schema
forall a. Semigroup a => a -> a -> a
(<>)



-- Wow, really wish I didn't have to manually export all of these lenses.
-- makeClassy has a workaround but then I get naming conflicts ......

$(makeLenses ''QN)
$(makeLenses ''Ref)
$(makeLenses ''SimpleType)
$(makeLenses ''Bound)
$(makeLenses ''SimpleRestriction)
$(makeLenses ''Union)
$(makeLenses ''Attribute)
$(makeLenses ''Use)
$(makeLenses ''AttributeGroup)
$(makeLenses ''Attributes)
$(makeLenses ''Occurs)
$(makeLenses ''Element)
$(makeLenses ''ComplexType)
$(makeLenses ''SimpleContent)
$(makeLenses ''ComplexContent)
$(makeLenses ''Compositor)
$(makeLenses ''Group)
$(makeLenses ''Particle)
$(makeLenses ''Choice)
$(makeLenses ''Sequence)
$(makeLenses ''Schema)

--
-- Resolvable
--

-- | Resolvable indicates a type has a 'Ref' member that it can
-- resolve from a top-level 'Schema' production.
class (Typeable a) => Resolvable a where
    resolve :: Schema -> a -> a

instance Resolvable AttributeGroup where
    resolve :: Schema -> AttributeGroup -> AttributeGroup
resolve Schema
sch = ASetter
  AttributeGroup
  AttributeGroup
  (Ref AttributeGroup)
  (Ref AttributeGroup)
-> (Ref AttributeGroup -> Ref AttributeGroup)
-> AttributeGroup
-> AttributeGroup
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  AttributeGroup
  AttributeGroup
  (Ref AttributeGroup)
  (Ref AttributeGroup)
Traversal' AttributeGroup (Ref AttributeGroup)
attrGroupRef (Schema -> Ref AttributeGroup -> Ref AttributeGroup
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable (Ref AttributeGroup) where
    resolve :: Schema -> Ref AttributeGroup -> Ref AttributeGroup
resolve = String
-> Getting (Map QN AttributeGroup) Schema (Map QN AttributeGroup)
-> Schema
-> Ref AttributeGroup
-> Ref AttributeGroup
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"AttributeGroup" Getting (Map QN AttributeGroup) Schema (Map QN AttributeGroup)
Lens' Schema (Map QN AttributeGroup)
attributeGroups


instance Resolvable Group where
    resolve :: Schema -> Group -> Group
resolve Schema
sch = ASetter Group Group (Ref Group) (Ref Group)
-> (Ref Group -> Ref Group) -> Group -> Group
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Group Group (Ref Group) (Ref Group)
Traversal' Group (Ref Group)
groupRef (Schema -> Ref Group -> Ref Group
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable (Ref Group) where
    resolve :: Schema -> Ref Group -> Ref Group
resolve = String
-> Getting (Map QN Group) Schema (Map QN Group)
-> Schema
-> Ref Group
-> Ref Group
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"Group" Getting (Map QN Group) Schema (Map QN Group)
Lens' Schema (Map QN Group)
groups

instance Resolvable ComplexContent where
    resolve :: Schema -> ComplexContent -> ComplexContent
resolve Schema
sch = ASetter
  ComplexContent ComplexContent (Ref ComplexType) (Ref ComplexType)
-> (Ref ComplexType -> Ref ComplexType)
-> ComplexContent
-> ComplexContent
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ComplexContent ComplexContent (Ref ComplexType) (Ref ComplexType)
Lens' ComplexContent (Ref ComplexType)
complexContentBase (Schema -> Ref ComplexType -> Ref ComplexType
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable (Ref ComplexType) where
    resolve :: Schema -> Ref ComplexType -> Ref ComplexType
resolve = String
-> Getting (Map QN ComplexType) Schema (Map QN ComplexType)
-> Schema
-> Ref ComplexType
-> Ref ComplexType
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"ComplexType" Getting (Map QN ComplexType) Schema (Map QN ComplexType)
Lens' Schema (Map QN ComplexType)
complexTypes

instance Resolvable SimpleContent where
    resolve :: Schema -> SimpleContent -> SimpleContent
resolve Schema
sch = ASetter
  SimpleContent SimpleContent (Ref SimpleType) (Ref SimpleType)
-> (Ref SimpleType -> Ref SimpleType)
-> SimpleContent
-> SimpleContent
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SimpleContent SimpleContent (Ref SimpleType) (Ref SimpleType)
Lens' SimpleContent (Ref SimpleType)
simpleContentBase (Schema -> Ref SimpleType -> Ref SimpleType
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable (Ref SimpleType) where
    resolve :: Schema -> Ref SimpleType -> Ref SimpleType
resolve = String
-> Getting (Map QN SimpleType) Schema (Map QN SimpleType)
-> Schema
-> Ref SimpleType
-> Ref SimpleType
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"SimpleType" Getting (Map QN SimpleType) Schema (Map QN SimpleType)
Lens' Schema (Map QN SimpleType)
simpleTypes

instance Resolvable Element where
    resolve :: Schema -> Element -> Element
resolve Schema
sch = ASetter Element Element (Ref Element) (Ref Element)
-> (Ref Element -> Ref Element) -> Element -> Element
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Element Element (Ref Element) (Ref Element)
Traversal' Element (Ref Element)
elementRef (Schema -> Ref Element -> Ref Element
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch) (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  Element
  Element
  (Ref (Either ComplexType SimpleType))
  (Ref (Either ComplexType SimpleType))
-> (Ref (Either ComplexType SimpleType)
    -> Ref (Either ComplexType SimpleType))
-> Element
-> Element
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  Element
  Element
  (Ref (Either ComplexType SimpleType))
  (Ref (Either ComplexType SimpleType))
Traversal' Element (Ref (Either ComplexType SimpleType))
elementType (Schema
-> Ref (Either ComplexType SimpleType)
-> Ref (Either ComplexType SimpleType)
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)


instance Resolvable (Ref (Either ComplexType SimpleType)) where
    resolve :: Schema
-> Ref (Either ComplexType SimpleType)
-> Ref (Either ComplexType SimpleType)
resolve Schema
sch (Unresolved QN
f) = QN
-> Either ComplexType SimpleType
-> Ref (Either ComplexType SimpleType)
forall a. QN -> a -> Ref a
Resolved QN
f (Either ComplexType SimpleType
 -> Ref (Either ComplexType SimpleType))
-> Either ComplexType SimpleType
-> Ref (Either ComplexType SimpleType)
forall a b. (a -> b) -> a -> b
$ (String -> Either ComplexType SimpleType)
-> (Either ComplexType SimpleType -> Either ComplexType SimpleType)
-> Either String (Either ComplexType SimpleType)
-> Either ComplexType SimpleType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either ComplexType SimpleType
forall a. HasCallStack => String -> a
error Either ComplexType SimpleType -> Either ComplexType SimpleType
forall a. a -> a
id
                                 ((ComplexType -> Either ComplexType SimpleType
forall a b. a -> Either a b
Left (ComplexType -> Either ComplexType SimpleType)
-> Either String ComplexType
-> Either String (Either ComplexType SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Getting (Map QN ComplexType) Schema (Map QN ComplexType)
-> QN
-> Schema
-> Either String ComplexType
forall b.
Resolvable b =>
String
-> Getting (Map QN b) Schema (Map QN b)
-> QN
-> Schema
-> Either String b
searchRefTarget String
"Either-ComplexType" Getting (Map QN ComplexType) Schema (Map QN ComplexType)
Lens' Schema (Map QN ComplexType)
complexTypes QN
f Schema
sch)
                                  Either String (Either ComplexType SimpleType)
-> Either String (Either ComplexType SimpleType)
-> Either String (Either ComplexType SimpleType)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                  (SimpleType -> Either ComplexType SimpleType
forall a b. b -> Either a b
Right (SimpleType -> Either ComplexType SimpleType)
-> Either String SimpleType
-> Either String (Either ComplexType SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Getting (Map QN SimpleType) Schema (Map QN SimpleType)
-> QN
-> Schema
-> Either String SimpleType
forall b.
Resolvable b =>
String
-> Getting (Map QN b) Schema (Map QN b)
-> QN
-> Schema
-> Either String b
searchRefTarget String
"Either-SimpleType" Getting (Map QN SimpleType) Schema (Map QN SimpleType)
Lens' Schema (Map QN SimpleType)
simpleTypes QN
f Schema
sch))
    resolve Schema
_ Ref (Either ComplexType SimpleType)
r = Ref (Either ComplexType SimpleType)
r


instance Resolvable (Ref Element) where
    resolve :: Schema -> Ref Element -> Ref Element
resolve = String
-> Getting (Map QN Element) Schema (Map QN Element)
-> Schema
-> Ref Element
-> Ref Element
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"Element" Getting (Map QN Element) Schema (Map QN Element)
Lens' Schema (Map QN Element)
elements

instance Resolvable ComplexType where resolve :: Schema -> ComplexType -> ComplexType
resolve Schema
_ = ComplexType -> ComplexType
forall a. a -> a
id
instance Resolvable SimpleType where resolve :: Schema -> SimpleType -> SimpleType
resolve Schema
_ = SimpleType -> SimpleType
forall a. a -> a
id



instance Resolvable SimpleRestriction where
    resolve :: Schema -> SimpleRestriction -> SimpleRestriction
resolve Schema
sch = ASetter
  SimpleRestriction
  SimpleRestriction
  (Ref SimpleType)
  (Ref SimpleType)
-> (Ref SimpleType -> Ref SimpleType)
-> SimpleRestriction
-> SimpleRestriction
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  SimpleRestriction
  SimpleRestriction
  (Ref SimpleType)
  (Ref SimpleType)
Lens' SimpleRestriction (Ref SimpleType)
simpleRestrictBase (Schema -> Ref SimpleType -> Ref SimpleType
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable Union where
    resolve :: Schema -> Union -> Union
resolve Schema
sch = ASetter Union Union (Ref SimpleType) (Ref SimpleType)
-> (Ref SimpleType -> Ref SimpleType) -> Union -> Union
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([Ref SimpleType] -> Identity [Ref SimpleType])
-> Union -> Identity Union
Lens' Union [Ref SimpleType]
unionMemberTypes(([Ref SimpleType] -> Identity [Ref SimpleType])
 -> Union -> Identity Union)
-> ((Ref SimpleType -> Identity (Ref SimpleType))
    -> [Ref SimpleType] -> Identity [Ref SimpleType])
-> ASetter Union Union (Ref SimpleType) (Ref SimpleType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Ref SimpleType -> Identity (Ref SimpleType))
-> [Ref SimpleType] -> Identity [Ref SimpleType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (Schema -> Ref SimpleType -> Ref SimpleType
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)


instance Resolvable Attribute where
    resolve :: Schema -> Attribute -> Attribute
resolve Schema
sch = ASetter Attribute Attribute (Ref Attribute) (Ref Attribute)
-> (Ref Attribute -> Ref Attribute) -> Attribute -> Attribute
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Attribute Attribute (Ref Attribute) (Ref Attribute)
Traversal' Attribute (Ref Attribute)
attrRef (Schema -> Ref Attribute -> Ref Attribute
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch) (Attribute -> Attribute)
-> (Attribute -> Attribute) -> Attribute -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  ASetter Attribute Attribute (Ref SimpleType) (Ref SimpleType)
-> (Ref SimpleType -> Ref SimpleType) -> Attribute -> Attribute
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Attribute Attribute (Ref SimpleType) (Ref SimpleType)
Traversal' Attribute (Ref SimpleType)
attrType (Schema -> Ref SimpleType -> Ref SimpleType
forall a. Resolvable a => Schema -> a -> a
resolve Schema
sch)

instance Resolvable (Ref Attribute) where
    resolve :: Schema -> Ref Attribute -> Ref Attribute
resolve = String
-> Getting (Map QN Attribute) Schema (Map QN Attribute)
-> Schema
-> Ref Attribute
-> Ref Attribute
forall r.
Resolvable r =>
String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
"Attribute" Getting (Map QN Attribute) Schema (Map QN Attribute)
Lens' Schema (Map QN Attribute)
attributes

-- | Resolve a 'Ref' against a 'Schema'.
refResolve
  :: Resolvable r =>
     String
     -> Getting (Map QN r) Schema (Map QN r)
     -> Schema
     -> Ref r
     -> Ref r
refResolve :: String
-> Getting (Map QN r) Schema (Map QN r) -> Schema -> Ref r -> Ref r
refResolve String
n Getting (Map QN r) Schema (Map QN r)
l Schema
sch (Unresolved QN
f) = QN -> r -> Ref r
forall a. QN -> a -> Ref a
Resolved QN
f (r -> Ref r) -> r -> Ref r
forall a b. (a -> b) -> a -> b
$ (String -> r) -> (r -> r) -> Either String r -> r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> r
forall a. HasCallStack => String -> a
error r -> r
forall a. a -> a
id (Either String r -> r) -> Either String r -> r
forall a b. (a -> b) -> a -> b
$ String
-> Getting (Map QN r) Schema (Map QN r)
-> QN
-> Schema
-> Either String r
forall b.
Resolvable b =>
String
-> Getting (Map QN b) Schema (Map QN b)
-> QN
-> Schema
-> Either String b
searchRefTarget String
n Getting (Map QN r) Schema (Map QN r)
l QN
f Schema
sch
refResolve String
_ Getting (Map QN r) Schema (Map QN r)
_ Schema
_ Ref r
r = Ref r
r

-- | Search top-level 'QN's for a 'Ref's target.
-- | Once found, target refs are also resolved -- not sure if necessary/practical.
searchRefTarget
  :: Resolvable b =>
     String
     -> Getting (Map QN b) Schema (Map QN b)
     -> QN
     -> Schema
     -> Either String b
searchRefTarget :: String
-> Getting (Map QN b) Schema (Map QN b)
-> QN
-> Schema
-> Either String b
searchRefTarget String
n Getting (Map QN b) Schema (Map QN b)
targetLens QN
v Schema
x = Maybe b -> Either String b
forall b. Resolvable b => Maybe b -> Either String b
found (Maybe b -> Either String b)
-> (Map QN b -> Maybe b) -> Map QN b -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QN -> Map QN b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup QN
v (Map QN b -> Either String b) -> Map QN b -> Either String b
forall a b. (a -> b) -> a -> b
$ Getting (Map QN b) Schema (Map QN b) -> Schema -> Map QN b
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map QN b) Schema (Map QN b)
targetLens Schema
x
    where found :: Maybe b -> Either String b
found (Just b
a) = b -> Either String b
forall a b. b -> Either a b
Right (Schema -> b -> b
forall a. Resolvable a => Schema -> a -> a
resolve Schema
x b
a)
          found Maybe b
Nothing = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ref search failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QN -> String
forall a. Show a => a -> String
show QN
v



--
-- PARSING
--

-- | Consume a range attribute.
ranged :: XParser m => String -> (String -> Bound String) -> m (Bound String)
ranged :: String -> (String -> Bound String) -> m (Bound String)
ranged String
e String -> Bound String
ctor = String -> Bound String
ctor (String -> Bound String) -> m String -> m (Bound String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String -> m String
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
e) (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"value"))

-- | Consume a minInclusive restriction.
minRestrict :: XParser m => m (Bound String)
minRestrict :: m (Bound String)
minRestrict = String -> (String -> Bound String) -> m (Bound String)
forall (m :: * -> *).
XParser m =>
String -> (String -> Bound String) -> m (Bound String)
ranged String
"minInclusive" String -> Bound String
forall a. a -> Bound a
Inclusive m (Bound String) -> m (Bound String) -> m (Bound String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> (String -> Bound String) -> m (Bound String)
forall (m :: * -> *).
XParser m =>
String -> (String -> Bound String) -> m (Bound String)
ranged String
"minExclusive" String -> Bound String
forall a. a -> Bound a
Exclusive

-- | Consume a maxInclusive restriction.
maxRestrict :: XParser m => m (Bound String)
maxRestrict :: m (Bound String)
maxRestrict = String -> (String -> Bound String) -> m (Bound String)
forall (m :: * -> *).
XParser m =>
String -> (String -> Bound String) -> m (Bound String)
ranged String
"maxInclusive" String -> Bound String
forall a. a -> Bound a
Inclusive m (Bound String) -> m (Bound String) -> m (Bound String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> (String -> Bound String) -> m (Bound String)
forall (m :: * -> *).
XParser m =>
String -> (String -> Bound String) -> m (Bound String)
ranged String
"maxExclusive" String -> Bound String
forall a. a -> Bound a
Exclusive

-- | Consume a pattern restriction.
pattern :: XParser m => m String
pattern :: m String
pattern = QName -> m String -> m String
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"pattern") (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"value"))

-- | Parse enum restrictions.
enums :: XParser m => m [String]
enums :: m [String]
enums = QName -> m String -> m [String]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"enumeration") (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"value"))

-- | Parse a QName.
qn :: String -> QN
qn :: String -> QN
qn = Parsec String () QN -> String -> QN
forall s t a. Stream s Identity t => Parsec s () a -> s -> a
parsec Parsec String () QN
forall m. Parsec String m QN
qnParser

-- | Match a simpleType restriction.
simpleRestrict :: XParser m => m SimpleRestriction
simpleRestrict :: m SimpleRestriction
simpleRestrict =
    QName -> m SimpleRestriction -> m SimpleRestriction
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"restriction") (m SimpleRestriction -> m SimpleRestriction)
-> m SimpleRestriction -> m SimpleRestriction
forall a b. (a -> b) -> a -> b
$
    Ref SimpleType
-> [String]
-> Maybe (Bound String)
-> Maybe (Bound String)
-> Maybe String
-> SimpleRestriction
SimpleRestriction (Ref SimpleType
 -> [String]
 -> Maybe (Bound String)
 -> Maybe (Bound String)
 -> Maybe String
 -> SimpleRestriction)
-> m (Ref SimpleType)
-> m ([String]
      -> Maybe (Bound String)
      -> Maybe (Bound String)
      -> Maybe String
      -> SimpleRestriction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QN -> Ref SimpleType
forall a. QN -> Ref a
Unresolved (QN -> Ref SimpleType)
-> (String -> QN) -> String -> Ref SimpleType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref SimpleType) -> m String -> m (Ref SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"base"))
                          m ([String]
   -> Maybe (Bound String)
   -> Maybe (Bound String)
   -> Maybe String
   -> SimpleRestriction)
-> m [String]
-> m (Maybe (Bound String)
      -> Maybe (Bound String) -> Maybe String -> SimpleRestriction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [String]
forall (m :: * -> *). XParser m => m [String]
enums m (Maybe (Bound String)
   -> Maybe (Bound String) -> Maybe String -> SimpleRestriction)
-> m (Maybe (Bound String))
-> m (Maybe (Bound String) -> Maybe String -> SimpleRestriction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Bound String) -> m (Maybe (Bound String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Bound String)
forall (m :: * -> *). XParser m => m (Bound String)
minRestrict m (Maybe (Bound String) -> Maybe String -> SimpleRestriction)
-> m (Maybe (Bound String))
-> m (Maybe String -> SimpleRestriction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                              m (Bound String) -> m (Maybe (Bound String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (Bound String)
forall (m :: * -> *). XParser m => m (Bound String)
maxRestrict m (Maybe String -> SimpleRestriction)
-> m (Maybe String) -> m SimpleRestriction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). XParser m => m String
pattern

-- | Match a simpleType union.
union :: XParser m => m Union
union :: m Union
union = QName -> m Union -> m Union
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"union") (m Union -> m Union) -> m Union -> m Union
forall a b. (a -> b) -> a -> b
$ do
          let wsDelimited :: ParsecT String u Identity [String]
wsDelimited = ParsecT String u Identity String
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT String u Identity String
forall m. Parsec String m String
attrParser ParsecT String u Identity String
-> (String -> ParsecT String u Identity String)
-> ParsecT String u Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
r -> ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces ParsecT String u Identity ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
r)
          [Ref SimpleType]
mts <- (String -> Ref SimpleType) -> [String] -> [Ref SimpleType]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> Ref SimpleType
forall a. QN -> Ref a
Unresolved (QN -> Ref SimpleType)
-> (String -> QN) -> String -> Ref SimpleType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn) ([String] -> [Ref SimpleType])
-> (String -> [String]) -> String -> [Ref SimpleType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () [String] -> String -> [String]
forall s t a. Stream s Identity t => Parsec s () a -> s -> a
parsec Parsec String () [String]
forall u. ParsecT String u Identity [String]
wsDelimited (String -> [Ref SimpleType]) -> m String -> m [Ref SimpleType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"memberTypes")
          [SimpleType]
uts <- QName -> m SimpleType -> m [SimpleType]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"simpleType") m SimpleType
forall (m :: * -> *). XParser m => m SimpleType
simpleType
          Union -> m Union
forall (m :: * -> *) a. Monad m => a -> m a
return (Union -> m Union) -> Union -> m Union
forall a b. (a -> b) -> a -> b
$ [Ref SimpleType] -> [SimpleType] -> Union
Union [Ref SimpleType]
mts [SimpleType]
uts

-- | Run parsec.
parsec :: (P.Stream s Identity t) => P.Parsec s () a -> s -> a
parsec :: Parsec s () a -> s -> a
parsec Parsec s () a
p s
s = (ParseError -> a) -> (a -> a) -> Either ParseError a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error(String -> a) -> (ParseError -> String) -> ParseError -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseError -> String
forall a. Show a => a -> String
show) a -> a
forall a. a -> a
id (Either ParseError a -> a) -> Either ParseError a -> a
forall a b. (a -> b) -> a -> b
$ Parsec s () a -> String -> s -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec s () a
p String
"ParseXsd" s
s

-- | Attribute text parser, without whitespace.
attrParser :: P.Parsec String m String
attrParser :: Parsec String m String
attrParser = (:) (Char -> ShowS)
-> ParsecT String m Identity Char
-> ParsecT String m Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String m Identity Char
forall u. ParsecT String u Identity Char
h ParsecT String m Identity ShowS
-> Parsec String m String -> Parsec String m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec String m String
forall m. Parsec String m String
r
    where h :: ParsecT String u Identity Char
h = ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"_:"
          r :: ParsecT String u Identity String
r = ParsecT String u Identity Char -> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"-_:."

-- | QName parser.
qnParser :: P.Parsec String m QN
qnParser :: Parsec String m QN
qnParser = Parsec String m QN -> Parsec String m QN
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try ((\String
p Char
_ String
l -> String -> Maybe String -> QN
QN String
l (String -> Maybe String
forall a. a -> Maybe a
Just String
p)) (String -> Char -> String -> QN)
-> ParsecT String m Identity String
-> ParsecT String m Identity (Char -> String -> QN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String m Identity Char -> ParsecT String m Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String m Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter ParsecT String m Identity Char
-> ParsecT String m Identity Char -> ParsecT String m Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"_") ParsecT String m Identity (Char -> String -> QN)
-> ParsecT String m Identity Char
-> ParsecT String m Identity (String -> QN)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
           Char -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
':' ParsecT String m Identity (String -> QN)
-> ParsecT String m Identity String -> Parsec String m QN
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String m Identity Char -> ParsecT String m Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String m Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String m Identity Char
-> ParsecT String m Identity Char -> ParsecT String m Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"-_.")) Parsec String m QN -> Parsec String m QN -> Parsec String m QN
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           (String -> Maybe String -> QN
`QN` Maybe String
forall a. Maybe a
Nothing) (String -> QN)
-> ParsecT String m Identity String -> Parsec String m QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String m Identity Char -> ParsecT String m Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String m Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String m Identity Char
-> ParsecT String m Identity Char -> ParsecT String m Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"-_.")

-- | Match documentation, always optional.
documentation :: XParser m => m (Maybe Documentation)
documentation :: m (Maybe Documentation)
documentation = (String -> Maybe Documentation
check(String -> Maybe Documentation)
-> ([[String]] -> String) -> [[String]] -> Maybe Documentation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[String]] -> Maybe Documentation)
-> m [[String]] -> m (Maybe Documentation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                QName -> m [String] -> m [[String]]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"annotation")
                (QName -> m String -> m [String]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"documentation")
                 m String
forall (m :: * -> *). XParser m => m String
textContent)
    where check :: String -> Maybe Documentation
check [] = Maybe Documentation
forall a. Maybe a
Nothing
          check String
s = Documentation -> Maybe Documentation
forall a. a -> Maybe a
Just (String -> Documentation
Documentation String
s)

-- | Match a simpleType.
simpleType :: XParser m => m SimpleType
simpleType :: m SimpleType
simpleType = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"simpleType")
  Maybe QN
n <- (String -> QN) -> Maybe String -> Maybe QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QN
qn (Maybe String -> Maybe QN) -> m (Maybe String) -> m (Maybe QN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name"))
  Maybe QN -> SimpleRestriction -> Maybe Documentation -> SimpleType
SimpleTypeRestrict Maybe QN
n (SimpleRestriction -> Maybe Documentation -> SimpleType)
-> m SimpleRestriction -> m (Maybe Documentation -> SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SimpleRestriction
forall (m :: * -> *). XParser m => m SimpleRestriction
simpleRestrict m (Maybe Documentation -> SimpleType)
-> m (Maybe Documentation) -> m SimpleType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
    m SimpleType -> m SimpleType -> m SimpleType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QN -> Union -> Maybe Documentation -> SimpleType
SimpleTypeUnion Maybe QN
n (Union -> Maybe Documentation -> SimpleType)
-> m Union -> m (Maybe Documentation -> SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Union
forall (m :: * -> *). XParser m => m Union
union m (Maybe Documentation -> SimpleType)
-> m (Maybe Documentation) -> m SimpleType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation

-- | Match an attribute.
attribute :: XParser m => m Attribute
attribute :: m Attribute
attribute = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"attribute")
  Maybe String
d <- m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"default"))
  Maybe String
u <- m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"use"))
  Use
u' <- case Maybe String
u of
          Maybe String
Nothing -> Use -> m Use
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Optional
          Just String
v | String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"required" -> Use -> m Use
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Required
                 | String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"optional" -> Use -> m Use
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Optional
                 | String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"prohibited" -> Use -> m Use
forall (m :: * -> *) a. Monad m => a -> m a
return Use
Prohibited
                 | Bool
otherwise -> String -> m Use
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m Use) -> String -> m Use
forall a b. (a -> b) -> a -> b
$ String
"Invalid use value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v
  let aNorm :: m Attribute
aNorm = do
              QN
n <- String -> QN
qn (String -> QN) -> m String -> m QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")
              QN
t <- String -> QN
qn (String -> QN) -> m String -> m QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"type")
              Attribute -> m Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> m Attribute) -> Attribute -> m Attribute
forall a b. (a -> b) -> a -> b
$ QN -> Ref SimpleType -> Use -> Maybe String -> Attribute
AttributeType QN
n (QN -> Ref SimpleType
forall a. QN -> Ref a
Unresolved QN
t) Use
u' Maybe String
d
      aRef :: m Attribute
aRef = do
              QN
r <- String -> QN
qn (String -> QN) -> m String -> m QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"ref")
              Attribute -> m Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> m Attribute) -> Attribute -> m Attribute
forall a b. (a -> b) -> a -> b
$ Ref Attribute -> Use -> Maybe String -> Attribute
AttributeRef (QN -> Ref Attribute
forall a. QN -> Ref a
Unresolved QN
r) Use
u' Maybe String
d
      aSimp :: m Attribute
aSimp = do
              QN
n <- String -> QN
qn (String -> QN) -> m String -> m QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")
              SimpleType
t <- m SimpleType -> m SimpleType
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m SimpleType
forall (m :: * -> *). XParser m => m SimpleType
simpleType
              Attribute -> m Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> m Attribute) -> Attribute -> m Attribute
forall a b. (a -> b) -> a -> b
$ QN -> SimpleType -> Attribute
AttributeSimpleType QN
n SimpleType
t
  m Attribute
aNorm m Attribute -> m Attribute -> m Attribute
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Attribute
aRef m Attribute -> m Attribute -> m Attribute
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Attribute
aSimp

-- | Match an attributeGroup.
attributeGroup :: XParser m => m AttributeGroup
attributeGroup :: m AttributeGroup
attributeGroup = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"attributeGroup")
  -- debugStack >> error "attributeGroup"
  QN -> Attributes -> Maybe Documentation -> AttributeGroup
AttributeGroup (QN -> Attributes -> Maybe Documentation -> AttributeGroup)
-> (String -> QN)
-> String
-> Attributes
-> Maybe Documentation
-> AttributeGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Attributes -> Maybe Documentation -> AttributeGroup)
-> m String
-> m (Attributes -> Maybe Documentation -> AttributeGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name") m (Attributes -> Maybe Documentation -> AttributeGroup)
-> m Attributes -> m (Maybe Documentation -> AttributeGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Attributes
forall (m :: * -> *). XParser m => m Attributes
attrs m (Maybe Documentation -> AttributeGroup)
-> m (Maybe Documentation) -> m AttributeGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation m AttributeGroup -> m AttributeGroup -> m AttributeGroup
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Ref AttributeGroup -> AttributeGroup
AttributeGroupRef (Ref AttributeGroup -> AttributeGroup)
-> (String -> Ref AttributeGroup) -> String -> AttributeGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QN -> Ref AttributeGroup
forall a. QN -> Ref a
Unresolved (QN -> Ref AttributeGroup)
-> (String -> QN) -> String -> Ref AttributeGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn) (String -> AttributeGroup) -> m String -> m AttributeGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"ref")

-- | Match attributes and attributeGroups (which often come together).
attrs :: XParser m => m Attributes
attrs :: m Attributes
attrs = [Attribute] -> [AttributeGroup] -> Attributes
Attributes ([Attribute] -> [AttributeGroup] -> Attributes)
-> m [Attribute] -> m ([AttributeGroup] -> Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               QName -> m Attribute -> m [Attribute]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"attribute") m Attribute
forall (m :: * -> *). XParser m => m Attribute
attribute m ([AttributeGroup] -> Attributes)
-> m [AttributeGroup] -> m Attributes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
               QName -> m AttributeGroup -> m [AttributeGroup]
forall (m :: * -> *) a. XParser m => QName -> m a -> m [a]
findChildren (String -> QName
xsName String
"attributeGroup") m AttributeGroup
forall (m :: * -> *). XParser m => m AttributeGroup
attributeGroup



-- | Match a complex type.
complexType :: XParser m => m ComplexType
complexType :: m ComplexType
complexType = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"complexType")
  Maybe QN
n <- (String -> QN) -> Maybe String -> Maybe QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QN
qn (Maybe String -> Maybe QN) -> m (Maybe String) -> m (Maybe QN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name"))
  Maybe QN -> SimpleContent -> Maybe Documentation -> ComplexType
ComplexTypeSimple Maybe QN
n (SimpleContent -> Maybe Documentation -> ComplexType)
-> m SimpleContent -> m (Maybe Documentation -> ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SimpleContent
forall (m :: * -> *). XParser m => m SimpleContent
simpleContent m (Maybe Documentation -> ComplexType)
-> m (Maybe Documentation) -> m ComplexType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
    m ComplexType -> m ComplexType -> m ComplexType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QN -> ComplexContent -> Maybe Documentation -> ComplexType
ComplexTypeComplex Maybe QN
n (ComplexContent -> Maybe Documentation -> ComplexType)
-> m ComplexContent -> m (Maybe Documentation -> ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ComplexContent
forall (m :: * -> *). XParser m => m ComplexContent
complexContent m (Maybe Documentation -> ComplexType)
-> m (Maybe Documentation) -> m ComplexType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
    m ComplexType -> m ComplexType -> m ComplexType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QN
-> Maybe Compositor
-> Attributes
-> Maybe Documentation
-> ComplexType
ComplexTypeCompositor Maybe QN
n (Maybe Compositor
 -> Attributes -> Maybe Documentation -> ComplexType)
-> m (Maybe Compositor)
-> m (Attributes -> Maybe Documentation -> ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Compositor -> m (Maybe Compositor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Compositor -> m Compositor
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m Compositor
forall (m :: * -> *). XParser m => m Compositor
compositor) m (Attributes -> Maybe Documentation -> ComplexType)
-> m Attributes -> m (Maybe Documentation -> ComplexType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Attributes
forall (m :: * -> *). XParser m => m Attributes
attrs m (Maybe Documentation -> ComplexType)
-> m (Maybe Documentation) -> m ComplexType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation

-- | Match simple content.
simpleContent :: XParser m => m SimpleContent
simpleContent :: m SimpleContent
simpleContent = QName -> m SimpleContent -> m SimpleContent
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"simpleContent")
                (QName -> m SimpleContent -> m SimpleContent
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"extension")
                 (Ref SimpleType -> Attributes -> SimpleContent
SimpleContentExtension (Ref SimpleType -> Attributes -> SimpleContent)
-> m (Ref SimpleType) -> m (Attributes -> SimpleContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QN -> Ref SimpleType
forall a. QN -> Ref a
Unresolved (QN -> Ref SimpleType)
-> (String -> QN) -> String -> Ref SimpleType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref SimpleType) -> m String -> m (Ref SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"base")) m (Attributes -> SimpleContent) -> m Attributes -> m SimpleContent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Attributes
forall (m :: * -> *). XParser m => m Attributes
attrs))

-- | Match complex content.
complexContent :: XParser m => m ComplexContent
complexContent :: m ComplexContent
complexContent = QName -> m ComplexContent -> m ComplexContent
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"complexContent")
                 (QName -> m ComplexContent -> m ComplexContent
forall (m :: * -> *) a. XParser m => QName -> m a -> m a
findChild (String -> QName
xsName String
"extension")
                  (Ref ComplexType -> Attributes -> Maybe Compositor -> ComplexContent
ComplexContentExtension (Ref ComplexType
 -> Attributes -> Maybe Compositor -> ComplexContent)
-> m (Ref ComplexType)
-> m (Attributes -> Maybe Compositor -> ComplexContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QN -> Ref ComplexType
forall a. QN -> Ref a
Unresolved (QN -> Ref ComplexType)
-> (String -> QN) -> String -> Ref ComplexType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref ComplexType) -> m String -> m (Ref ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"base")) m (Attributes -> Maybe Compositor -> ComplexContent)
-> m Attributes -> m (Maybe Compositor -> ComplexContent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                                           m Attributes
forall (m :: * -> *). XParser m => m Attributes
attrs m (Maybe Compositor -> ComplexContent)
-> m (Maybe Compositor) -> m ComplexContent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Compositor -> m (Maybe Compositor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Compositor -> m Compositor
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m Compositor
forall (m :: * -> *). XParser m => m Compositor
compositor)))

-- | Consume a compositor production.
compositor :: XParser m => m Compositor
compositor :: m Compositor
compositor = Group -> Compositor
CompositorGroup (Group -> Compositor) -> m Group -> m Compositor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Group
forall (m :: * -> *). XParser m => m Group
group m Compositor -> m Compositor -> m Compositor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             Sequence -> Compositor
CompositorSequence (Sequence -> Compositor) -> m Sequence -> m Compositor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Sequence
forall (m :: * -> *). XParser m => m Sequence
sequence m Compositor -> m Compositor -> m Compositor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             Choice -> Compositor
CompositorChoice (Choice -> Compositor) -> m Choice -> m Compositor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Choice
forall (m :: * -> *). XParser m => m Choice
choice

-- | Match group.
group :: XParser m => m Group
group :: m Group
group = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"group")
  Ref Group -> Occurs -> Group
GroupRef (Ref Group -> Occurs -> Group)
-> m (Ref Group) -> m (Occurs -> Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QN -> Ref Group
forall a. QN -> Ref a
Unresolved (QN -> Ref Group) -> (String -> QN) -> String -> Ref Group
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref Group) -> m String -> m (Ref Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"ref")) m (Occurs -> Group) -> m Occurs -> m Group
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs
    m Group -> m Group -> m Group
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QN -> Occurs -> Choice -> Maybe Documentation -> Group
GroupChoice (Maybe QN -> Occurs -> Choice -> Maybe Documentation -> Group)
-> m (Maybe QN)
-> m (Occurs -> Choice -> Maybe Documentation -> Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> QN) -> Maybe String -> Maybe QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QN
qn (Maybe String -> Maybe QN) -> m (Maybe String) -> m (Maybe QN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")))
            m (Occurs -> Choice -> Maybe Documentation -> Group)
-> m Occurs -> m (Choice -> Maybe Documentation -> Group)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m (Choice -> Maybe Documentation -> Group)
-> m Choice -> m (Maybe Documentation -> Group)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Choice -> m Choice
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m Choice
forall (m :: * -> *). XParser m => m Choice
choice m (Maybe Documentation -> Group)
-> m (Maybe Documentation) -> m Group
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
    m Group -> m Group -> m Group
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QN -> Occurs -> Sequence -> Maybe Documentation -> Group
GroupSequence (Maybe QN -> Occurs -> Sequence -> Maybe Documentation -> Group)
-> m (Maybe QN)
-> m (Occurs -> Sequence -> Maybe Documentation -> Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> QN) -> Maybe String -> Maybe QN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> QN
qn (Maybe String -> Maybe QN) -> m (Maybe String) -> m (Maybe QN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")))
            m (Occurs -> Sequence -> Maybe Documentation -> Group)
-> m Occurs -> m (Sequence -> Maybe Documentation -> Group)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m (Sequence -> Maybe Documentation -> Group)
-> m Sequence -> m (Maybe Documentation -> Group)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Sequence -> m Sequence
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m Sequence
forall (m :: * -> *). XParser m => m Sequence
sequence m (Maybe Documentation -> Group)
-> m (Maybe Documentation) -> m Group
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation

-- | Parse occurs-* attributes.
occurs :: XParser m => m Occurs
occurs :: m Occurs
occurs = Maybe String -> Maybe String -> Occurs
Occurs (Maybe String -> Maybe String -> Occurs)
-> m (Maybe String) -> m (Maybe String -> Occurs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"minOccurs")) m (Maybe String -> Occurs) -> m (Maybe String) -> m Occurs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"maxOccurs"))

-- | Match sequence.
sequence :: XParser m => m Sequence
sequence :: m Sequence
sequence = QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"sequence") m () -> m Sequence -> m Sequence
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Occurs -> [Particle] -> Sequence
Sequence (Occurs -> [Particle] -> Sequence)
-> m Occurs -> m ([Particle] -> Sequence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m ([Particle] -> Sequence) -> m [Particle] -> m Sequence
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Particle]
forall (m :: * -> *). XParser m => m [Particle]
particles

-- | Match choice.
choice :: XParser m => m Choice
choice :: m Choice
choice = QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"choice") m () -> m Choice -> m Choice
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Occurs -> [Particle] -> Choice
Choice (Occurs -> [Particle] -> Choice)
-> m Occurs -> m ([Particle] -> Choice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m ([Particle] -> Choice) -> m [Particle] -> m Choice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Particle]
forall (m :: * -> *). XParser m => m [Particle]
particles

-- | Consume a particle production.
particles :: XParser m => m [Particle]
particles :: m [Particle]
particles = m Particle -> m [Particle]
forall (m :: * -> *) a. XParser m => m a -> m [a]
allChildren (Group -> Particle
PartGroup (Group -> Particle) -> m Group -> m Particle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Group
forall (m :: * -> *). XParser m => m Group
group m Particle -> m Particle -> m Particle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         Sequence -> Particle
PartSequence (Sequence -> Particle) -> m Sequence -> m Particle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Sequence
forall (m :: * -> *). XParser m => m Sequence
sequence m Particle -> m Particle -> m Particle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         Choice -> Particle
PartChoice (Choice -> Particle) -> m Choice -> m Particle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Choice
forall (m :: * -> *). XParser m => m Choice
choice m Particle -> m Particle -> m Particle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         Element -> Particle
PartElement (Element -> Particle) -> m Element -> m Particle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element
forall (m :: * -> *). XParser m => m Element
element)

-- | Match element.
element :: XParser m => m Element
element :: m Element
element = do
  QName -> m ()
forall (m :: * -> *). XParser m => QName -> m ()
atEl (String -> QName
xsName String
"element")
  let el :: m Element
el = QN
-> Ref (Either ComplexType SimpleType)
-> Occurs
-> Maybe Documentation
-> Element
ElementType (QN
 -> Ref (Either ComplexType SimpleType)
 -> Occurs
 -> Maybe Documentation
 -> Element)
-> (String -> QN)
-> String
-> Ref (Either ComplexType SimpleType)
-> Occurs
-> Maybe Documentation
-> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String
 -> Ref (Either ComplexType SimpleType)
 -> Occurs
 -> Maybe Documentation
 -> Element)
-> m String
-> m (Ref (Either ComplexType SimpleType)
      -> Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")
           m (Ref (Either ComplexType SimpleType)
   -> Occurs -> Maybe Documentation -> Element)
-> m (Ref (Either ComplexType SimpleType))
-> m (Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QN -> Ref (Either ComplexType SimpleType)
forall a. QN -> Ref a
Unresolved (QN -> Ref (Either ComplexType SimpleType))
-> (String -> QN) -> String -> Ref (Either ComplexType SimpleType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref (Either ComplexType SimpleType))
-> m String -> m (Ref (Either ComplexType SimpleType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"type")) m (Occurs -> Maybe Documentation -> Element)
-> m Occurs -> m (Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m (Maybe Documentation -> Element)
-> m (Maybe Documentation) -> m Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
      elSim :: m Element
elSim = QN -> SimpleType -> Occurs -> Maybe Documentation -> Element
ElementSimple (QN -> SimpleType -> Occurs -> Maybe Documentation -> Element)
-> (String -> QN)
-> String
-> SimpleType
-> Occurs
-> Maybe Documentation
-> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> SimpleType -> Occurs -> Maybe Documentation -> Element)
-> m String
-> m (SimpleType -> Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")
              m (SimpleType -> Occurs -> Maybe Documentation -> Element)
-> m SimpleType -> m (Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m SimpleType -> m SimpleType
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m SimpleType
forall (m :: * -> *). XParser m => m SimpleType
simpleType m (Occurs -> Maybe Documentation -> Element)
-> m Occurs -> m (Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m (Maybe Documentation -> Element)
-> m (Maybe Documentation) -> m Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
      elCom :: m Element
elCom = QN -> ComplexType -> Occurs -> Maybe Documentation -> Element
ElementComplex (QN -> ComplexType -> Occurs -> Maybe Documentation -> Element)
-> (String -> QN)
-> String
-> ComplexType
-> Occurs
-> Maybe Documentation
-> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> ComplexType -> Occurs -> Maybe Documentation -> Element)
-> m String
-> m (ComplexType -> Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"name")
              m (ComplexType -> Occurs -> Maybe Documentation -> Element)
-> m ComplexType -> m (Occurs -> Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ComplexType -> m ComplexType
forall (m :: * -> *) a. XParser m => m a -> m a
oneChild m ComplexType
forall (m :: * -> *). XParser m => m ComplexType
complexType m (Occurs -> Maybe Documentation -> Element)
-> m Occurs -> m (Maybe Documentation -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs m (Maybe Documentation -> Element)
-> m (Maybe Documentation) -> m Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Maybe Documentation)
forall (m :: * -> *). XParser m => m (Maybe Documentation)
documentation
      elRef :: m Element
elRef = Ref Element -> Occurs -> Element
ElementRef (Ref Element -> Occurs -> Element)
-> m (Ref Element) -> m (Occurs -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QN -> Ref Element
forall a. QN -> Ref a
Unresolved (QN -> Ref Element) -> (String -> QN) -> String -> Ref Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QN
qn (String -> Ref Element) -> m String -> m (Ref Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> m String
forall (m :: * -> *). XParser m => QName -> m String
attr (String -> QName
name String
"ref")) m (Occurs -> Element) -> m Occurs -> m Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Occurs
forall (m :: * -> *). XParser m => m Occurs
occurs
  m Element
el m Element -> m Element -> m Element
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Element
elRef m Element -> m Element -> m Element
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Element
elSim m Element -> m Element -> m Element
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Element
elCom


-- | Main parser.
schemaParser :: XParser m => m Schema
schemaParser :: m Schema
schemaParser = Map QN SimpleType
-> Map QN ComplexType
-> Map QN Group
-> Map QN AttributeGroup
-> Map QN Element
-> Map QN Attribute
-> Schema
Schema (Map QN SimpleType
 -> Map QN ComplexType
 -> Map QN Group
 -> Map QN AttributeGroup
 -> Map QN Element
 -> Map QN Attribute
 -> Schema)
-> m (Map QN SimpleType)
-> m (Map QN ComplexType
      -> Map QN Group
      -> Map QN AttributeGroup
      -> Map QN Element
      -> Map QN Attribute
      -> Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         (Getting (Leftmost (Maybe QN)) SimpleType (Maybe QN)
-> [SimpleType] -> Map QN SimpleType
forall a.
Show a =>
Getting (Leftmost (Maybe QN)) a (Maybe QN) -> [a] -> Map QN a
mapifyJust Getting (Leftmost (Maybe QN)) SimpleType (Maybe QN)
Lens' SimpleType (Maybe QN)
simpleTypeName ([SimpleType] -> Map QN SimpleType)
-> m [SimpleType] -> m (Map QN SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SimpleType -> m [SimpleType]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m SimpleType
forall (m :: * -> *). XParser m => m SimpleType
simpleType) m (Map QN ComplexType
   -> Map QN Group
   -> Map QN AttributeGroup
   -> Map QN Element
   -> Map QN Attribute
   -> Schema)
-> m (Map QN ComplexType)
-> m (Map QN Group
      -> Map QN AttributeGroup
      -> Map QN Element
      -> Map QN Attribute
      -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         (Getting (Leftmost (Maybe QN)) ComplexType (Maybe QN)
-> [ComplexType] -> Map QN ComplexType
forall a.
Show a =>
Getting (Leftmost (Maybe QN)) a (Maybe QN) -> [a] -> Map QN a
mapifyJust Getting (Leftmost (Maybe QN)) ComplexType (Maybe QN)
Lens' ComplexType (Maybe QN)
complexTypeName ([ComplexType] -> Map QN ComplexType)
-> m [ComplexType] -> m (Map QN ComplexType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ComplexType -> m [ComplexType]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m ComplexType
forall (m :: * -> *). XParser m => m ComplexType
complexType) m (Map QN Group
   -> Map QN AttributeGroup
   -> Map QN Element
   -> Map QN Attribute
   -> Schema)
-> m (Map QN Group)
-> m (Map QN AttributeGroup
      -> Map QN Element -> Map QN Attribute -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         (Getting (Leftmost (Maybe QN)) Group (Maybe QN)
-> [Group] -> Map QN Group
forall a.
Show a =>
Getting (Leftmost (Maybe QN)) a (Maybe QN) -> [a] -> Map QN a
mapifyJust Getting (Leftmost (Maybe QN)) Group (Maybe QN)
Traversal' Group (Maybe QN)
groupName ([Group] -> Map QN Group) -> m [Group] -> m (Map QN Group)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Group -> m [Group]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m Group
forall (m :: * -> *). XParser m => m Group
group) m (Map QN AttributeGroup
   -> Map QN Element -> Map QN Attribute -> Schema)
-> m (Map QN AttributeGroup)
-> m (Map QN Element -> Map QN Attribute -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         (Getting (Leftmost QN) AttributeGroup QN
-> [AttributeGroup] -> Map QN AttributeGroup
forall a. Show a => Getting (Leftmost QN) a QN -> [a] -> Map QN a
mapify Getting (Leftmost QN) AttributeGroup QN
Traversal' AttributeGroup QN
attrGroupName ([AttributeGroup] -> Map QN AttributeGroup)
-> m [AttributeGroup] -> m (Map QN AttributeGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AttributeGroup -> m [AttributeGroup]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m AttributeGroup
forall (m :: * -> *). XParser m => m AttributeGroup
attributeGroup) m (Map QN Element -> Map QN Attribute -> Schema)
-> m (Map QN Element) -> m (Map QN Attribute -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         (Getting (Leftmost QN) Element QN -> [Element] -> Map QN Element
forall a. Show a => Getting (Leftmost QN) a QN -> [a] -> Map QN a
mapify Getting (Leftmost QN) Element QN
Traversal' Element QN
elementName ([Element] -> Map QN Element) -> m [Element] -> m (Map QN Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Element -> m [Element]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m Element
forall (m :: * -> *). XParser m => m Element
element) m (Map QN Attribute -> Schema) -> m (Map QN Attribute) -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         (Getting (Leftmost QN) Attribute QN
-> [Attribute] -> Map QN Attribute
forall a. Show a => Getting (Leftmost QN) a QN -> [a] -> Map QN a
mapify Getting (Leftmost QN) Attribute QN
Traversal' Attribute QN
attrName ([Attribute] -> Map QN Attribute)
-> m [Attribute] -> m (Map QN Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Attribute -> m [Attribute]
forall (m :: * -> *) a. XParser m => m a -> m [a]
anyChildren m Attribute
forall (m :: * -> *). XParser m => m Attribute
attribute)


mapify :: Show a => Getting (Leftmost QN) a QN -> [a] -> Map QN a
mapify :: Getting (Leftmost QN) a QN -> [a] -> Map QN a
mapify Getting (Leftmost QN) a QN
l = [(QN, a)] -> Map QN a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(QN, a)] -> Map QN a) -> ([a] -> [(QN, a)]) -> [a] -> Map QN a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (QN, a)) -> [a] -> [(QN, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (a -> Maybe QN -> QN
forall a a. Show a => a -> Maybe a -> a
justName a
a (Maybe QN -> QN) -> Maybe QN -> QN
forall a b. (a -> b) -> a -> b
$ Getting (Leftmost QN) a QN -> a -> Maybe QN
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf Getting (Leftmost QN) a QN
l a
a,a
a))
    where justName :: a -> Maybe a -> a
justName a
a = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"mapify: name field not present: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a)

mapifyJust :: Show a => Getting (Leftmost (Maybe QN)) a (Maybe QN) -> [a] -> Map QN a
mapifyJust :: Getting (Leftmost (Maybe QN)) a (Maybe QN) -> [a] -> Map QN a
mapifyJust Getting (Leftmost (Maybe QN)) a (Maybe QN)
l = [(QN, a)] -> Map QN a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(QN, a)] -> Map QN a) -> ([a] -> [(QN, a)]) -> [a] -> Map QN a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (QN, a)) -> [a] -> [(QN, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (a -> Maybe (Maybe QN) -> QN
forall a c. Show a => a -> Maybe (Maybe c) -> c
justName a
a (Maybe (Maybe QN) -> QN) -> Maybe (Maybe QN) -> QN
forall a b. (a -> b) -> a -> b
$ Getting (Leftmost (Maybe QN)) a (Maybe QN) -> a -> Maybe (Maybe QN)
forall a s. Getting (Leftmost a) s a -> s -> Maybe a
firstOf Getting (Leftmost (Maybe QN)) a (Maybe QN)
l a
a, a
a))
    where justName :: a -> Maybe (Maybe c) -> c
justName a
a = c -> Maybe c -> c
forall a. a -> Maybe a -> a
fromMaybe (String -> c
forall a. HasCallStack => String -> a
error (String -> c) -> String -> c
forall a b. (a -> b) -> a -> b
$ String
"mapifyJust: name required at top level: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a) (Maybe c -> c)
-> (Maybe (Maybe c) -> Maybe c) -> Maybe (Maybe c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       Maybe c -> Maybe (Maybe c) -> Maybe c
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe c
forall a. HasCallStack => String -> a
error (String -> Maybe c) -> String -> Maybe c
forall a b. (a -> b) -> a -> b
$ String
"mapify: name field not present: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a)


-- | Adjust top-level names to have supplied prefix.
namespaceSchema :: String -> Schema -> Schema
namespaceSchema :: String -> Schema -> Schema
namespaceSchema String
ns =
    let pfx :: (QN, b) -> (QN, b)
pfx (QN
k,b
v) = (QN -> QN
setPfx QN
k, ASetter b b QN QN -> (QN -> QN) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter b b QN QN
forall s a. (Data s, Typeable a) => Traversal' s a
template QN -> QN
justNoPfx b
v)
        justNoPfx :: QN -> QN
justNoPfx q :: QN
q@(QN String
_ (Just String
_)) = QN
q
        justNoPfx QN
q = QN -> QN
setPfx QN
q
        setPfx :: QN -> QN
setPfx = ASetter QN QN (Maybe String) (Maybe String)
-> Maybe String -> QN -> QN
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter QN QN (Maybe String) (Maybe String)
Lens' QN (Maybe String)
qPrefix (String -> Maybe String
forall a. a -> Maybe a
Just String
ns)
        remap :: Data a => M.Map QN a -> M.Map QN a
        remap :: Map QN a -> Map QN a
remap = [(QN, a)] -> Map QN a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(QN, a)] -> Map QN a)
-> (Map QN a -> [(QN, a)]) -> Map QN a -> Map QN a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter [(QN, a)] [(QN, a)] (QN, a) (QN, a)
-> ((QN, a) -> (QN, a)) -> [(QN, a)] -> [(QN, a)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter [(QN, a)] [(QN, a)] (QN, a) (QN, a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (QN, a) -> (QN, a)
forall b. Data b => (QN, b) -> (QN, b)
pfx ([(QN, a)] -> [(QN, a)])
-> (Map QN a -> [(QN, a)]) -> Map QN a -> [(QN, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map QN a -> [(QN, a)]
forall k a. Map k a -> [(k, a)]
M.toList
    in
    ASetter Schema Schema (Map QN SimpleType) (Map QN SimpleType)
-> (Map QN SimpleType -> Map QN SimpleType) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema (Map QN SimpleType) (Map QN SimpleType)
Lens' Schema (Map QN SimpleType)
simpleTypes Map QN SimpleType -> Map QN SimpleType
forall a. Data a => Map QN a -> Map QN a
remap (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter Schema Schema (Map QN ComplexType) (Map QN ComplexType)
-> (Map QN ComplexType -> Map QN ComplexType) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema (Map QN ComplexType) (Map QN ComplexType)
Lens' Schema (Map QN ComplexType)
complexTypes Map QN ComplexType -> Map QN ComplexType
forall a. Data a => Map QN a -> Map QN a
remap (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter Schema Schema (Map QN Group) (Map QN Group)
-> (Map QN Group -> Map QN Group) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema (Map QN Group) (Map QN Group)
Lens' Schema (Map QN Group)
groups Map QN Group -> Map QN Group
forall a. Data a => Map QN a -> Map QN a
remap (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter
  Schema Schema (Map QN AttributeGroup) (Map QN AttributeGroup)
-> (Map QN AttributeGroup -> Map QN AttributeGroup)
-> Schema
-> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  Schema Schema (Map QN AttributeGroup) (Map QN AttributeGroup)
Lens' Schema (Map QN AttributeGroup)
attributeGroups Map QN AttributeGroup -> Map QN AttributeGroup
forall a. Data a => Map QN a -> Map QN a
remap (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter Schema Schema (Map QN Element) (Map QN Element)
-> (Map QN Element -> Map QN Element) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema (Map QN Element) (Map QN Element)
Lens' Schema (Map QN Element)
elements Map QN Element -> Map QN Element
forall a. Data a => Map QN a -> Map QN a
remap (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter Schema Schema (Map QN Attribute) (Map QN Attribute)
-> (Map QN Attribute -> Map QN Attribute) -> Schema -> Schema
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Schema Schema (Map QN Attribute) (Map QN Attribute)
Lens' Schema (Map QN Attribute)
attributes Map QN Attribute -> Map QN Attribute
forall a. Data a => Map QN a -> Map QN a
remap

-- | XML Schema "anySimpleType" (ie, built-ins like string, double etc).
anySimpleTypeName :: QN
anySimpleTypeName :: QN
anySimpleTypeName = String -> Maybe String -> QN
QN String
"anySimpleType" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xs")

-- | Load XSD itself as a 'Schema'.
loadXsdSchema :: FilePath -> IO Schema
loadXsdSchema :: String -> IO Schema
loadXsdSchema String
f = do
  Map QN SimpleType
ts <- Schema -> Map QN SimpleType
_simpleTypes (Schema -> Map QN SimpleType)
-> (Schema -> Schema) -> Schema -> Map QN SimpleType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Schema -> Schema
namespaceSchema String
"xs" (Schema -> Map QN SimpleType)
-> IO Schema -> IO (Map QN SimpleType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Schema
parseFile String
f
  let anySimpleType :: SimpleType
anySimpleType = Maybe QN -> SimpleRestriction -> Maybe Documentation -> SimpleType
SimpleTypeRestrict (QN -> Maybe QN
forall a. a -> Maybe a
Just QN
anySimpleTypeName)
                      (Ref SimpleType
-> [String]
-> Maybe (Bound String)
-> Maybe (Bound String)
-> Maybe String
-> SimpleRestriction
SimpleRestriction Ref SimpleType
forall a. Ref a
Final [] Maybe (Bound String)
forall a. Maybe a
Nothing Maybe (Bound String)
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
                      Maybe Documentation
forall a. Maybe a
Nothing
  let s :: Schema
s = ASetter Schema Schema (Map QN SimpleType) (Map QN SimpleType)
-> Map QN SimpleType -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Schema Schema (Map QN SimpleType) (Map QN SimpleType)
Lens' Schema (Map QN SimpleType)
simpleTypes (QN -> SimpleType -> Map QN SimpleType -> Map QN SimpleType
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert QN
anySimpleTypeName SimpleType
anySimpleType Map QN SimpleType
ts) Schema
forall a. Monoid a => a
mempty
  Schema -> IO Schema
forall (m :: * -> *) a. Monad m => a -> m a
return Schema
s


-- | Parse an XSD file.
parseFile :: FilePath -> IO Schema
parseFile :: String -> IO Schema
parseFile String
f = String -> IO Element
readXml String
f IO Element
-> (Element -> IO (Either String Schema))
-> IO (Either String Schema)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StateT [Element] (ExceptT String IO) Schema
-> Element -> IO (Either String Schema)
forall (m :: * -> *) b.
Monad m =>
StateT [Element] (ExceptT String m) b
-> Element -> m (Either String b)
parseX StateT [Element] (ExceptT String IO) Schema
forall (m :: * -> *). XParser m => m Schema
schemaParser IO (Either String Schema)
-> (Either String Schema -> IO Schema) -> IO Schema
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Schema)
-> (Schema -> IO Schema) -> Either String Schema -> IO Schema
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO Schema
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Schema)
-> (String -> IOError) -> String -> IO Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError) Schema -> IO Schema
forall (m :: * -> *) a. Monad m => a -> m a
return