{-# LANGUAGE PatternGuards #-}
module Text.XML.HaXml.Schema.TypeConversion
( module Text.XML.HaXml.Schema.TypeConversion
) where
import Text.XML.HaXml.Types (QName(..),Name(..),Namespace(..))
import Text.XML.HaXml.Namespaces (printableName,localName)
import Text.XML.HaXml.Schema.Environment
import Text.XML.HaXml.Schema.XSDTypeModel as XSD
import Text.XML.HaXml.Schema.HaskellTypeModel as Haskell
import Text.XML.HaXml.Schema.NameConversion
import Text.XML.HaXml.Schema.Parse (xsd)
import qualified Data.Map as Map
import Data.Semigroup (Semigroup (..))
import Data.Map (Map)
import Data.List (foldl')
import Data.Maybe (fromMaybe,fromJust,isNothing,isJust)
import Data.Monoid (Monoid (..))
typeLift :: Schema -> Schema
typeLift :: Schema -> Schema
typeLift s :: Schema
s = Schema
s{ schema_items :: [SchemaItem]
schema_items =
[[SchemaItem]] -> [SchemaItem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ElementDecl -> [SchemaItem]
hoist ElementDecl
e | SchemaElement e :: ElementDecl
e <- Schema -> [SchemaItem]
schema_items Schema
s ]
[SchemaItem] -> [SchemaItem] -> [SchemaItem]
forall a. [a] -> [a] -> [a]
++ (SchemaItem -> SchemaItem) -> [SchemaItem] -> [SchemaItem]
forall a b. (a -> b) -> [a] -> [b]
map SchemaItem -> SchemaItem
renameLocals (Schema -> [SchemaItem]
schema_items Schema
s) }
where
hoist :: ElementDecl -> [SchemaItem]
hoist :: ElementDecl -> [SchemaItem]
hoist e :: ElementDecl
e = ((ElementDecl -> [SchemaItem]) -> [ElementDecl] -> [SchemaItem])
-> [ElementDecl] -> (ElementDecl -> [SchemaItem]) -> [SchemaItem]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ElementDecl -> [SchemaItem]) -> [ElementDecl] -> [SchemaItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ElementDecl -> [ElementDecl]
findE ElementDecl
e) ((ElementDecl -> [SchemaItem]) -> [SchemaItem])
-> (ElementDecl -> [SchemaItem]) -> [SchemaItem]
forall a b. (a -> b) -> a -> b
$
\e :: ElementDecl
e@ElementDecl{elem_nameOrRef :: ElementDecl -> Either NameAndType QName
elem_nameOrRef=Left (NT{ theName :: NameAndType -> Name
theName=Name
n
})}->
Name -> Maybe (Either SimpleType ComplexType) -> [SchemaItem]
localType Name
n (ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
e)
findE :: ElementDecl -> [ElementDecl]
findE :: ElementDecl -> [ElementDecl]
findE e :: ElementDecl
e = ( case ElementDecl -> Either NameAndType QName
elem_nameOrRef ElementDecl
e of
Left (NT{theType :: NameAndType -> Maybe QName
theType=Maybe QName
Nothing}) -> (ElementDecl
eElementDecl -> [ElementDecl] -> [ElementDecl]
forall a. a -> [a] -> [a]
:)
Left (NT{theType :: NameAndType -> Maybe QName
theType=Just t :: QName
t}) -> case ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
e of
Just (Right
(ComplexType
{complex_name :: ComplexType -> Maybe Name
complex_name=Just t' :: Name
t'}))
-> (ElementDecl
eElementDecl -> [ElementDecl] -> [ElementDecl]
forall a. a -> [a] -> [a]
:)
_ -> [ElementDecl] -> [ElementDecl]
forall a. a -> a
id
_ -> [ElementDecl] -> [ElementDecl]
forall a. a -> a
id
) ([ElementDecl] -> [ElementDecl]) -> [ElementDecl] -> [ElementDecl]
forall a b. (a -> b) -> a -> b
$
( case ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
e of
Nothing -> []
Just (Left _) -> []
Just (Right c :: ComplexType
c) ->
case ComplexType -> ComplexItem
complex_content ComplexType
c of
v :: ComplexItem
v@SimpleContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
ci_stuff=Left (Restriction1 p :: Particle
p)} -> Particle -> [ElementDecl]
particle Particle
p
v :: ComplexItem
v@SimpleContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
ci_stuff=Right (Extension{extension_newstuff :: Extension -> ParticleAttrs
extension_newstuff=PA p :: Particle
p _ _})} -> Particle -> [ElementDecl]
particle Particle
p
v :: ComplexItem
v@ComplexContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
ci_stuff=Left (Restriction1 p :: Particle
p)} -> Particle -> [ElementDecl]
particle Particle
p
v :: ComplexItem
v@ComplexContent{ci_stuff :: ComplexItem -> Either Restriction1 Extension
ci_stuff=Right (Extension{extension_newstuff :: Extension -> ParticleAttrs
extension_newstuff=PA p :: Particle
p _ _})} -> Particle -> [ElementDecl]
particle Particle
p
v :: ComplexItem
v@ThisType{ci_thistype :: ComplexItem -> ParticleAttrs
ci_thistype=PA p :: Particle
p _ _} -> Particle -> [ElementDecl]
particle Particle
p
)
particle :: Particle -> [ElementDecl]
particle Nothing = []
particle (Just (Left cos :: ChoiceOrSeq
cos)) = ChoiceOrSeq -> [ElementDecl]
choiceOrSeq ChoiceOrSeq
cos
particle (Just (Right g :: Group
g)) = [ElementDecl]
-> (ChoiceOrSeq -> [ElementDecl])
-> Maybe ChoiceOrSeq
-> [ElementDecl]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ChoiceOrSeq -> [ElementDecl]
choiceOrSeq (Maybe ChoiceOrSeq -> [ElementDecl])
-> Maybe ChoiceOrSeq -> [ElementDecl]
forall a b. (a -> b) -> a -> b
$ Group -> Maybe ChoiceOrSeq
group_stuff Group
g
choiceOrSeq :: ChoiceOrSeq -> [ElementDecl]
choiceOrSeq (XSD.All _ es :: [ElementDecl]
es) = (ElementDecl -> [ElementDecl]) -> [ElementDecl] -> [ElementDecl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElementDecl -> [ElementDecl]
findE [ElementDecl]
es
choiceOrSeq (XSD.Choice _ _ es :: [ElementEtc]
es) = (ElementEtc -> [ElementDecl]) -> [ElementEtc] -> [ElementDecl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElementEtc -> [ElementDecl]
etc [ElementEtc]
es
choiceOrSeq (XSD.Sequence _ _ es :: [ElementEtc]
es) = (ElementEtc -> [ElementDecl]) -> [ElementEtc] -> [ElementDecl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElementEtc -> [ElementDecl]
etc [ElementEtc]
es
etc :: ElementEtc -> [ElementDecl]
etc (HasElement e :: ElementDecl
e) = ElementDecl -> [ElementDecl]
findE ElementDecl
e
etc (HasGroup g :: Group
g) = [ElementDecl]
-> (ChoiceOrSeq -> [ElementDecl])
-> Maybe ChoiceOrSeq
-> [ElementDecl]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ChoiceOrSeq -> [ElementDecl]
choiceOrSeq (Maybe ChoiceOrSeq -> [ElementDecl])
-> Maybe ChoiceOrSeq -> [ElementDecl]
forall a b. (a -> b) -> a -> b
$ Group -> Maybe ChoiceOrSeq
group_stuff Group
g
etc (HasCS cos :: ChoiceOrSeq
cos) = ChoiceOrSeq -> [ElementDecl]
choiceOrSeq ChoiceOrSeq
cos
etc (HasAny _) = []
localType :: Name -> Maybe (Either SimpleType ComplexType) -> [SchemaItem]
localType n :: Name
n Nothing = []
localType n :: Name
n (Just (Left s :: SimpleType
s)) = [SimpleType -> SchemaItem
Simple (Name -> SimpleType -> SimpleType
renameSimple Name
n SimpleType
s)]
localType n :: Name
n (Just (Right c :: ComplexType
c)) = [ComplexType -> SchemaItem
Complex ComplexType
c{ complex_name :: Maybe Name
complex_name = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n }]
renameSimple :: Name -> SimpleType -> SimpleType
renameSimple n :: Name
n s :: SimpleType
s@Primitive{} = SimpleType
s
renameSimple n :: Name
n s :: SimpleType
s@Restricted{} = SimpleType
s{ simple_name :: Maybe Name
simple_name = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n }
renameSimple n :: Name
n s :: SimpleType
s@ListOf{} = SimpleType
s{ simple_name :: Maybe Name
simple_name = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n }
renameSimple n :: Name
n s :: SimpleType
s@UnionOf{} = SimpleType
s{ simple_name :: Maybe Name
simple_name = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n }
renameLocals :: SchemaItem -> SchemaItem
renameLocals :: SchemaItem -> SchemaItem
renameLocals s :: SchemaItem
s = SchemaItem
s
convert :: Environment -> Schema -> [Haskell.Decl]
convert :: Environment -> Schema -> [Decl]
convert env :: Environment
env s :: Schema
s = (SchemaItem -> [Decl]) -> [SchemaItem] -> [Decl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SchemaItem -> [Decl]
item (Schema -> [SchemaItem]
schema_items Schema
s)
where
item :: SchemaItem -> [Decl]
item (Include loc :: Name
loc ann :: Annotation
ann) = [XName -> Maybe Name -> Decl
XSDInclude (Name -> XName
xname Name
loc) (Annotation -> Maybe Name
comment Annotation
ann)]
item (Import uri :: Name
uri loc :: Name
loc ann :: Annotation
ann) = [XName -> Maybe XName -> Maybe Name -> Decl
XSDImport (Name -> XName
xname Name
loc)
((Name -> XName) -> Maybe Name -> Maybe XName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> XName
xname (Maybe Name -> Maybe XName) -> Maybe Name -> Maybe XName
forall a b. (a -> b) -> a -> b
$
Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
uri (Environment -> Map Name Name
env_namespace Environment
env))
(Annotation -> Maybe Name
comment Annotation
ann)]
item (Redefine _ _) = []
item (Annotation ann :: Annotation
ann) = [Maybe Name -> Decl
XSDComment (Annotation -> Maybe Name
comment Annotation
ann)]
item (Simple st :: SimpleType
st) = SimpleType -> [Decl]
simple SimpleType
st
item (Complex ct :: ComplexType
ct) = ComplexType -> [Decl]
complex ComplexType
ct
item (SchemaElement ed :: ElementDecl
ed) = ElementDecl -> [Decl]
topElementDecl ElementDecl
ed
item (SchemaAttribute ad :: AttributeDecl
ad) = []
item (AttributeGroup ag :: AttrGroup
ag) = []
item (SchemaGroup g :: Group
g) = Group -> [Decl]
group Group
g
simple :: SimpleType -> [Decl]
simple (Primitive prim :: PrimitiveType
prim) = []
simple s :: SimpleType
s@(Restricted a :: Annotation
a n :: Maybe Name
n f :: Maybe Final
f r :: Restriction
r)
| (Just enums :: [(XName, Maybe Name)]
enums) <- SimpleType -> Maybe [(XName, Maybe Name)]
isEnumeration SimpleType
s
= [XName -> [(XName, Maybe Name)] -> Maybe Name -> Decl
EnumSimpleType
(XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
forall a. HasCallStack => Name -> a
error "missing Name") Name -> XName
xname Maybe Name
n)
[(XName, Maybe Name)]
enums (Annotation -> Maybe Name
comment Annotation
a) ]
| Bool
otherwise = [XName -> XName -> [Restrict] -> Maybe Name -> Decl
RestrictSimpleType
(XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
forall a. HasCallStack => Name -> a
error "missing Name") Name -> XName
xname Maybe Name
n)
(XName -> (QName -> XName) -> Maybe QName -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
xname "unknownSimple") QName -> XName
XName
(Restriction -> Maybe QName
restrict_base Restriction
r))
(Restriction -> [Restrict]
mkRestrict Restriction
r)
(Annotation -> Maybe Name
comment Annotation
a)]
simple (ListOf a :: Annotation
a n :: Maybe Name
n f :: Maybe Final
f t :: Either SimpleType QName
t) = Name -> [Decl]
forall a. HasCallStack => Name -> a
error "Not yet implemented: ListOf simpleType"
simple s :: SimpleType
s@(UnionOf a :: Annotation
a n :: Maybe Name
n f :: Maybe Final
f u :: [SimpleType]
u m :: [QName]
m)
| (Just enums :: [(XName, Maybe Name)]
enums) <- SimpleType -> Maybe [(XName, Maybe Name)]
isEnumeration SimpleType
s
= [XName -> [(XName, Maybe Name)] -> Maybe Name -> Decl
EnumSimpleType
(XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
forall a. HasCallStack => Name -> a
error "missing Name") Name -> XName
xname Maybe Name
n)
[(XName, Maybe Name)]
enums (Annotation -> Maybe Name
comment Annotation
a) ]
| Bool
otherwise = [XName -> [XName] -> Maybe Name -> Decl
UnionSimpleTypes
(XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
forall a. HasCallStack => Name -> a
error "missing Name") Name -> XName
xname Maybe Name
n)
((QName -> XName) -> [QName] -> [XName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> XName
xname (Name -> XName) -> (QName -> Name) -> QName -> XName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Name
printableName) [QName]
m)
(Annotation -> Maybe Name
comment Annotation
a)]
isEnumeration :: SimpleType -> Maybe [(XName,Comment)]
isEnumeration :: SimpleType -> Maybe [(XName, Maybe Name)]
isEnumeration (Primitive _) = Maybe [(XName, Maybe Name)]
forall a. Maybe a
Nothing
isEnumeration (ListOf _ _ _ _) = Maybe [(XName, Maybe Name)]
forall a. Maybe a
Nothing
isEnumeration (Restricted _ _ _ r :: Restriction
r) =
case Restriction
r of
RestrictSim1 ann :: Annotation
ann base :: Maybe QName
base r1 :: Restriction1
r1 -> Maybe [(XName, Maybe Name)]
forall a. Maybe a
Nothing
RestrictType _ _ _ facets :: [Facet]
facets ->
let enum :: [(XName, Maybe Name)]
enum = [ (Name -> XName
xname Name
v, Annotation -> Maybe Name
comment Annotation
ann)
| (Facet UnorderedEnumeration ann :: Annotation
ann v :: Name
v _) <- [Facet]
facets ]
in if [(XName, Maybe Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(XName, Maybe Name)]
enum then Maybe [(XName, Maybe Name)]
forall a. Maybe a
Nothing else [(XName, Maybe Name)] -> Maybe [(XName, Maybe Name)]
forall a. a -> Maybe a
Just [(XName, Maybe Name)]
enum
isEnumeration (UnionOf _ _ _ u :: [SimpleType]
u ms :: [QName]
ms) =
[(XName, Maybe Name)]
-> [Maybe [(XName, Maybe Name)]] -> Maybe [(XName, Maybe Name)]
forall a. [a] -> [Maybe [a]] -> Maybe [a]
squeeze [] ( ((QName -> Maybe [(XName, Maybe Name)])
-> [QName] -> [Maybe [(XName, Maybe Name)]])
-> [QName]
-> (QName -> Maybe [(XName, Maybe Name)])
-> [Maybe [(XName, Maybe Name)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (QName -> Maybe [(XName, Maybe Name)])
-> [QName] -> [Maybe [(XName, Maybe Name)]]
forall a b. (a -> b) -> [a] -> [b]
map [QName]
ms (\m :: QName
m-> case QName
-> Map QName (Either SimpleType ComplexType)
-> Maybe (Either SimpleType ComplexType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
m (Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
env) of
Just (Left s :: SimpleType
s)-> SimpleType -> Maybe [(XName, Maybe Name)]
isEnumeration SimpleType
s
_ -> Maybe [(XName, Maybe Name)]
forall a. Maybe a
Nothing)
[Maybe [(XName, Maybe Name)]]
-> [Maybe [(XName, Maybe Name)]] -> [Maybe [(XName, Maybe Name)]]
forall a. [a] -> [a] -> [a]
++ (SimpleType -> Maybe [(XName, Maybe Name)])
-> [SimpleType] -> [Maybe [(XName, Maybe Name)]]
forall a b. (a -> b) -> [a] -> [b]
map SimpleType -> Maybe [(XName, Maybe Name)]
isEnumeration [SimpleType]
u )
where squeeze :: [a] -> [Maybe [a]] -> Maybe [a]
squeeze _ (Nothing:_) = Maybe [a]
forall a. Maybe a
Nothing
squeeze xs :: [a]
xs (Just ys :: [a]
ys:rest :: [Maybe [a]]
rest) = [a] -> [Maybe [a]] -> Maybe [a]
squeeze ([a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ys) [Maybe [a]]
rest
squeeze xs :: [a]
xs [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
xs
complex :: ComplexType -> [Decl]
complex ct :: ComplexType
ct =
let nx :: QName
nx = Name -> QName
N (Name -> QName) -> Name -> QName
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe ("errorMissingName") (ComplexType -> Maybe Name
complex_name ComplexType
ct)
n :: XName
n = QName -> XName
XName QName
nx
in Decl -> [Decl]
forall a. a -> [a]
singleton (Decl -> [Decl]) -> Decl -> [Decl]
forall a b. (a -> b) -> a -> b
$
case ComplexType -> ComplexItem
complex_content ComplexType
ct of
c :: ComplexItem
c@SimpleContent{} ->
case ComplexItem -> Either Restriction1 Extension
ci_stuff ComplexItem
c of
Left r :: Restriction1
r ->
XName -> XName -> [Restrict] -> Maybe Name -> Decl
RestrictSimpleType XName
n (Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ "Unimplemented") []
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` ComplexItem -> Annotation
ci_annotation ComplexItem
c))
Right e :: Extension
e ->
XName -> XName -> [Attribute] -> Maybe Name -> Decl
ExtendSimpleType XName
n
(QName -> XName
XName (QName -> XName) -> QName -> XName
forall a b. (a -> b) -> a -> b
$ Extension -> QName
extension_base Extension
e)
(([Element], [Attribute]) -> [Attribute]
forall a b. (a, b) -> b
snd (([Element], [Attribute]) -> [Attribute])
-> ([Element], [Attribute]) -> [Attribute]
forall a b. (a -> b) -> a -> b
$
ParticleAttrs -> ([Element], [Attribute])
particleAttrs (ParticleAttrs -> ([Element], [Attribute]))
-> ParticleAttrs -> ([Element], [Attribute])
forall a b. (a -> b) -> a -> b
$ Extension -> ParticleAttrs
extension_newstuff Extension
e)
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` ComplexItem -> Annotation
ci_annotation ComplexItem
c
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` Extension -> Annotation
extension_annotation Extension
e))
c :: ComplexItem
c@ComplexContent{} ->
case ComplexItem -> Either Restriction1 Extension
ci_stuff ComplexItem
c of
Left r :: Restriction1
r ->
XName -> XName -> Maybe Name -> Decl
RestrictComplexType XName
n (Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ "Can'tBeRight")
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` ComplexItem -> Annotation
ci_annotation ComplexItem
c))
Right e :: Extension
e ->
let myLoc :: Name
myLoc = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe "NUL" (QName -> Map QName Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nx
(Environment -> Map QName Name
env_typeloc Environment
env))
supLoc :: Name
supLoc = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe "NUL" (QName -> Map QName Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Extension -> QName
extension_base Extension
e)
(Environment -> Map QName Name
env_typeloc Environment
env))
in
if ComplexType -> Bool
complex_abstract ComplexType
ct then
XName
-> XName
-> [(XName, Maybe XName)]
-> Maybe XName
-> [XName]
-> Maybe Name
-> Decl
ExtendComplexTypeAbstract XName
n
(QName -> XName
XName (QName -> XName) -> QName -> XName
forall a b. (a -> b) -> a -> b
$ Extension -> QName
extension_base Extension
e)
(
[(XName, Maybe XName)]
-> ([(QName, Name)] -> [(XName, Maybe XName)])
-> Maybe [(QName, Name)]
-> [(XName, Maybe XName)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> [(XName, Maybe XName)]
forall a. HasCallStack => Name -> a
error ("ExtendComplexTypeAbstract "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
forall a. Show a => a -> Name
show QName
nx))
(((QName, Name) -> (XName, Maybe XName))
-> [(QName, Name)] -> [(XName, Maybe XName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(t :: QName
t,l :: Name
l)->(QName -> XName
XName QName
t,if Name
lName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
myLoc
then XName -> Maybe XName
forall a. a -> Maybe a
Just (Name -> XName
xname Name
l)
else Maybe XName
forall a. Maybe a
Nothing)))
(QName -> Map QName [(QName, Name)] -> Maybe [(QName, Name)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nx (Environment -> Map QName [(QName, Name)]
env_extendty Environment
env)))
(if Name
myLocName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
supLoc
then XName -> Maybe XName
forall a. a -> Maybe a
Just (Name -> XName
xname Name
supLoc) else Maybe XName
forall a. Maybe a
Nothing)
(
(QName -> XName) -> [QName] -> [XName]
forall a b. (a -> b) -> [a] -> [b]
map QName -> XName
XName ([QName] -> [XName]) -> [QName] -> [XName]
forall a b. (a -> b) -> a -> b
$ (QName -> Maybe QName) -> QName -> [QName]
forall a. (a -> Maybe a) -> a -> [a]
repeatedly (Environment -> QName -> Maybe QName
supertypeOf Environment
env) QName
nx)
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` ComplexItem -> Annotation
ci_annotation ComplexItem
c
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` Extension -> Annotation
extension_annotation Extension
e))
else
let (es :: [Element]
es,as :: [Attribute]
as) = ParticleAttrs -> ([Element], [Attribute])
particleAttrs (Extension -> ParticleAttrs
extension_newstuff Extension
e)
es' :: [Element]
es' | ComplexItem -> Bool
ci_mixed ComplexItem
c = [Element] -> [Element]
mkMixedContent [Element]
es
| Bool
otherwise = [Element]
es
(oldEs :: [Element]
oldEs,oldAs :: [Attribute]
oldAs) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
contentInfo (Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute]))
-> Maybe (Either SimpleType ComplexType)
-> ([Element], [Attribute])
forall a b. (a -> b) -> a -> b
$
QName
-> Map QName (Either SimpleType ComplexType)
-> Maybe (Either SimpleType ComplexType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Extension -> QName
extension_base Extension
e)
(Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
env)
in
XName
-> XName
-> [Element]
-> [Attribute]
-> [Element]
-> [Attribute]
-> Maybe XName
-> Bool
-> [XName]
-> Maybe Name
-> Decl
ExtendComplexType XName
n
(QName -> XName
XName (QName -> XName) -> QName -> XName
forall a b. (a -> b) -> a -> b
$ Extension -> QName
extension_base Extension
e)
([Element]
oldEs)
([Attribute]
oldAs)
([Element]
es)
([Attribute]
as)
(if Name
myLocName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
supLoc then XName -> Maybe XName
forall a. a -> Maybe a
Just (Name -> XName
xname Name
supLoc)
else Maybe XName
forall a. Maybe a
Nothing)
(
Bool
-> (Either SimpleType ComplexType -> Bool)
-> Maybe (Either SimpleType ComplexType)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((SimpleType -> Bool)
-> (ComplexType -> Bool) -> Either SimpleType ComplexType -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> SimpleType -> Bool
forall a b. a -> b -> a
const Bool
False) ComplexType -> Bool
complex_abstract)
(QName
-> Map QName (Either SimpleType ComplexType)
-> Maybe (Either SimpleType ComplexType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Extension -> QName
extension_base Extension
e)
(Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
env)))
(
(QName -> XName) -> [QName] -> [XName]
forall a b. (a -> b) -> [a] -> [b]
map QName -> XName
XName ([QName] -> [XName]) -> [QName] -> [XName]
forall a b. (a -> b) -> a -> b
$ (QName -> Maybe QName) -> QName -> [QName]
forall a. (a -> Maybe a) -> a -> [a]
repeatedly (Environment -> QName -> Maybe QName
supertypeOf Environment
env)
(QName -> [QName]) -> QName -> [QName]
forall a b. (a -> b) -> a -> b
$ Extension -> QName
extension_base Extension
e)
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` ComplexItem -> Annotation
ci_annotation ComplexItem
c
Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
`mappend` Extension -> Annotation
extension_annotation Extension
e))
c :: ComplexItem
c@ThisType{} | ComplexType -> Bool
complex_abstract ComplexType
ct ->
let myLoc :: Name
myLoc = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe "NUL"
(QName -> Map QName Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nx (Environment -> Map QName Name
env_typeloc Environment
env)) in
XName -> [(XName, Maybe XName)] -> Maybe Name -> Decl
ElementsAttrsAbstract XName
n
(((QName, Name) -> (XName, Maybe XName))
-> [(QName, Name)] -> [(XName, Maybe XName)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (x :: QName
x,loc :: Name
loc)->(QName -> XName
XName QName
x,if Name
locName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
myLoc
then XName -> Maybe XName
forall a. a -> Maybe a
Just (Name -> XName
xname Name
loc)
else Maybe XName
forall a. Maybe a
Nothing))
([(QName, Name)] -> [(XName, Maybe XName)])
-> [(QName, Name)] -> [(XName, Maybe XName)]
forall a b. (a -> b) -> a -> b
$ [(QName, Name)] -> Maybe [(QName, Name)] -> [(QName, Name)]
forall a. a -> Maybe a -> a
fromMaybe []
(Maybe [(QName, Name)] -> [(QName, Name)])
-> Maybe [(QName, Name)] -> [(QName, Name)]
forall a b. (a -> b) -> a -> b
$ QName -> Map QName [(QName, Name)] -> Maybe [(QName, Name)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nx (Environment -> Map QName [(QName, Name)]
env_extendty Environment
env))
(Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct))
c :: ComplexItem
c@ThisType{} | Bool
otherwise ->
let (es :: [Element]
es,as :: [Attribute]
as) = ParticleAttrs -> ([Element], [Attribute])
particleAttrs (ComplexItem -> ParticleAttrs
ci_thistype ComplexItem
c)
es' :: [Element]
es' | ComplexType -> Bool
complex_mixed ComplexType
ct = [Element] -> [Element]
mkMixedContent [Element]
es
| Bool
otherwise = [Element]
es
in
XName -> [Element] -> [Attribute] -> Maybe Name -> Decl
ElementsAttrs XName
n [Element]
es' [Attribute]
as (Annotation -> Maybe Name
comment (ComplexType -> Annotation
complex_annotation ComplexType
ct))
mkMixedContent :: [Element] -> [Element]
mkMixedContent [e :: Element
e@OneOf{}] = [Element
e{ elem_oneOf :: [[Element]]
elem_oneOf = [Element
Text][Element] -> [[Element]] -> [[Element]]
forall a. a -> [a] -> [a]
: Element -> [[Element]]
elem_oneOf Element
e }]
mkMixedContent es :: [Element]
es = Element
TextElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\e :: Element
e->[Element
e,Element
Text]) [Element]
es
topElementDecl :: XSD.ElementDecl -> [Haskell.Decl]
topElementDecl :: ElementDecl -> [Decl]
topElementDecl ed :: ElementDecl
ed = case ElementDecl -> Either NameAndType QName
elem_nameOrRef ElementDecl
ed of
Left n :: NameAndType
n -> case NameAndType -> Maybe QName
theType NameAndType
n of
Nothing ->
let (es :: [Element]
es,as :: [Attribute]
as) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
contentInfo (ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
ed) in
[ XName -> [Element] -> [Attribute] -> Maybe Name -> Decl
ElementsAttrs (Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ NameAndType -> Name
theName NameAndType
n)
([Element]
es)
([Attribute]
as)
(Annotation -> Maybe Name
comment (ElementDecl -> Annotation
elem_annotation ElementDecl
ed))
, Element -> Decl
ElementOfType (Element -> Decl) -> Element -> Decl
forall a b. (a -> b) -> a -> b
$ ElementDecl -> Element
elementDecl ElementDecl
ed
]
Just t :: QName
t | ElementDecl -> Bool
elem_abstract ElementDecl
ed ->
let nm :: QName
nm = Name -> QName
N (Name -> QName) -> Name -> QName
forall a b. (a -> b) -> a -> b
$ NameAndType -> Name
theName NameAndType
n
myLoc :: Name
myLoc = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe "NUL"
(QName -> Map QName Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nm (Environment -> Map QName Name
env_typeloc Environment
env)) in
Decl -> [Decl]
forall a. a -> [a]
singleton (Decl -> [Decl]) -> Decl -> [Decl]
forall a b. (a -> b) -> a -> b
$
XName -> XName -> [(XName, Maybe XName)] -> Maybe Name -> Decl
ElementAbstractOfType
(QName -> XName
XName QName
nm)
(Schema -> QName -> XName
checkXName Schema
s QName
t)
(((QName, Name) -> (XName, Maybe XName))
-> [(QName, Name)] -> [(XName, Maybe XName)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (x :: QName
x,loc :: Name
loc)->(QName -> XName
XName QName
x,if Name
locName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/=Name
myLoc
then XName -> Maybe XName
forall a. a -> Maybe a
Just (Name -> XName
xname Name
loc)
else Maybe XName
forall a. Maybe a
Nothing))
([(QName, Name)] -> [(XName, Maybe XName)])
-> [(QName, Name)] -> [(XName, Maybe XName)]
forall a b. (a -> b) -> a -> b
$ [(QName, Name)] -> Maybe [(QName, Name)] -> [(QName, Name)]
forall a. a -> Maybe a -> a
fromMaybe []
(Maybe [(QName, Name)] -> [(QName, Name)])
-> Maybe [(QName, Name)] -> [(QName, Name)]
forall a b. (a -> b) -> a -> b
$ QName -> Map QName [(QName, Name)] -> Maybe [(QName, Name)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
nm (Environment -> Map QName [(QName, Name)]
env_substGrp Environment
env))
(Annotation -> Maybe Name
comment (ElementDecl -> Annotation
elem_annotation ElementDecl
ed))
Just t :: QName
t | Bool
otherwise ->
Decl -> [Decl]
forall a. a -> [a]
singleton (Decl -> [Decl]) -> Decl -> [Decl]
forall a b. (a -> b) -> a -> b
$ Element -> Decl
ElementOfType (Element -> Decl) -> Element -> Decl
forall a b. (a -> b) -> a -> b
$ ElementDecl -> Element
elementDecl ElementDecl
ed
Right ref :: QName
ref -> case QName -> Map QName ElementDecl -> Maybe ElementDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
ref (Environment -> Map QName ElementDecl
env_element Environment
env) of
Nothing -> Name -> [Decl]
forall a. HasCallStack => Name -> a
error (Name -> [Decl]) -> Name -> [Decl]
forall a b. (a -> b) -> a -> b
$ "<topElementDecl> unknown element reference "
Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
ref
Just e' :: ElementDecl
e' -> ElementDecl -> [Decl]
topElementDecl ElementDecl
e'
elementDecl :: XSD.ElementDecl -> Haskell.Element
elementDecl :: ElementDecl -> Element
elementDecl ed :: ElementDecl
ed = case ElementDecl -> Either NameAndType QName
elem_nameOrRef ElementDecl
ed of
Left n :: NameAndType
n -> Element :: XName
-> XName
-> Modifier
-> Bool
-> [Decl]
-> Maybe [XName]
-> Maybe Name
-> Element
Element { elem_name :: XName
elem_name = Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ NameAndType -> Name
theName NameAndType
n
, elem_type :: XName
elem_type = XName -> (QName -> XName) -> Maybe QName -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ElementDecl -> XName
localTypeExp ElementDecl
ed)
(Schema -> QName -> XName
checkXName Schema
s)
(NameAndType -> Maybe QName
theType NameAndType
n)
, elem_modifier :: Modifier
elem_modifier = Occurs -> Modifier
occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
forall a b. (a -> b) -> a -> b
$ ElementDecl -> Occurs
elem_occurs ElementDecl
ed
, elem_byRef :: Bool
elem_byRef = Bool
False
, elem_locals :: [Decl]
elem_locals = []
, elem_substs :: Maybe [XName]
elem_substs = Maybe [XName]
forall a. Maybe a
Nothing
, elem_comment :: Maybe Name
elem_comment = Annotation -> Maybe Name
comment (Annotation -> Maybe Name) -> Annotation -> Maybe Name
forall a b. (a -> b) -> a -> b
$ ElementDecl -> Annotation
elem_annotation ElementDecl
ed
}
Right ref :: QName
ref -> case QName -> Map QName ElementDecl -> Maybe ElementDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
ref (Environment -> Map QName ElementDecl
env_element Environment
env) of
Just e' :: ElementDecl
e' -> (ElementDecl -> Element
elementDecl ElementDecl
e')
{ elem_modifier :: Modifier
elem_modifier =
Occurs -> Modifier
occursToModifier (ElementDecl -> Occurs
elem_occurs ElementDecl
ed)
, elem_byRef :: Bool
elem_byRef = Bool
True }
Nothing ->
case QName -> Map QName ElementDecl -> Maybe ElementDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name -> QName
N (Name -> QName) -> Name -> QName
forall a b. (a -> b) -> a -> b
$ QName -> Name
localName QName
ref)
(Environment -> Map QName ElementDecl
env_element Environment
env) of
Just e' :: ElementDecl
e' -> (ElementDecl -> Element
elementDecl ElementDecl
e')
{ elem_modifier :: Modifier
elem_modifier =
Occurs -> Modifier
occursToModifier (ElementDecl -> Occurs
elem_occurs ElementDecl
ed)
, elem_byRef :: Bool
elem_byRef = Bool
True }
Nothing -> XName
-> XName
-> Modifier
-> Bool
-> [Decl]
-> Maybe [XName]
-> Maybe Name
-> Element
Element (QName -> XName
XName QName
ref)
(QName -> XName
XName QName
ref)
(Occurs -> Modifier
occursToModifier (ElementDecl -> Occurs
elem_occurs ElementDecl
ed))
Bool
True [] Maybe [XName]
forall a. Maybe a
Nothing Maybe Name
forall a. Maybe a
Nothing
localTypeExp :: XSD.ElementDecl -> XName
localTypeExp :: ElementDecl -> XName
localTypeExp ed :: ElementDecl
ed | Maybe (Either SimpleType ComplexType) -> Bool
forall a. Maybe a -> Bool
isJust (ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
ed) =
case Maybe (Either SimpleType ComplexType)
-> Either SimpleType ComplexType
forall a. HasCallStack => Maybe a -> a
fromJust (ElementDecl -> Maybe (Either SimpleType ComplexType)
elem_content ElementDecl
ed) of
Left st :: SimpleType
st@Primitive{} -> Name -> XName
xname "SomethingPrimitive"
Left st :: SimpleType
st@Restricted{} -> (\x :: XName
x-> XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XName
x Name -> XName
xname
(SimpleType -> Maybe Name
simple_name SimpleType
st)) (XName -> XName) -> XName -> XName
forall a b. (a -> b) -> a -> b
$
(XName -> (QName -> XName) -> Maybe QName -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
xname "GiveUp")
QName -> XName
XName (Maybe QName -> XName) -> Maybe QName -> XName
forall a b. (a -> b) -> a -> b
$
Restriction -> Maybe QName
restrict_base (Restriction -> Maybe QName) -> Restriction -> Maybe QName
forall a b. (a -> b) -> a -> b
$
SimpleType -> Restriction
simple_restriction SimpleType
st)
Left st :: SimpleType
st@ListOf{} -> Name -> XName
xname "SomethingListy"
Left st :: SimpleType
st@UnionOf{} -> Name -> XName
xname "SomethingUnionLike"
Right c :: ComplexType
c@ComplexType{} -> XName -> (Name -> XName) -> Maybe Name -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ElementDecl -> XName
localTypeExp ElementDecl
ed{elem_content :: Maybe (Either SimpleType ComplexType)
elem_content=Maybe (Either SimpleType ComplexType)
forall a. Maybe a
Nothing})
Name -> XName
xname
(Maybe Name -> XName) -> Maybe Name -> XName
forall a b. (a -> b) -> a -> b
$ ComplexType -> Maybe Name
complex_name ComplexType
c
| Bool
otherwise =
case ElementDecl -> Either NameAndType QName
elem_nameOrRef ElementDecl
ed of
Left n :: NameAndType
n -> Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ NameAndType -> Name
theName NameAndType
n
Right _ -> Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ "unknownElement"
attributeDecl :: XSD.AttributeDecl -> [Haskell.Attribute]
attributeDecl :: AttributeDecl -> [Attribute]
attributeDecl ad :: AttributeDecl
ad = case AttributeDecl -> Either NameAndType QName
attr_nameOrRef AttributeDecl
ad of
Left n :: NameAndType
n -> Attribute -> [Attribute]
forall a. a -> [a]
singleton (Attribute -> [Attribute]) -> Attribute -> [Attribute]
forall a b. (a -> b) -> a -> b
$
XName -> XName -> Bool -> Maybe Name -> Attribute
Attribute (Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ NameAndType -> Name
theName NameAndType
n)
(XName -> (QName -> XName) -> Maybe QName -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XName -> (SimpleType -> XName) -> Maybe SimpleType -> XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> XName
xname (Name -> XName) -> Name -> XName
forall a b. (a -> b) -> a -> b
$ "String")
SimpleType -> XName
nameOfSimple
(AttributeDecl -> Maybe SimpleType
attr_simpleType AttributeDecl
ad))
QName -> XName
XName
(NameAndType -> Maybe QName
theType NameAndType
n))
(AttributeDecl -> Use
attr_use AttributeDecl
ad Use -> Use -> Bool
forall a. Eq a => a -> a -> Bool
== Use
Required)
(Annotation -> Maybe Name
comment (AttributeDecl -> Annotation
attr_annotation AttributeDecl
ad))
Right ref :: QName
ref -> case QName -> Map QName AttributeDecl -> Maybe AttributeDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
ref (Environment -> Map QName AttributeDecl
env_attribute Environment
env) of
Nothing -> Name -> [Attribute]
forall a. HasCallStack => Name -> a
error (Name -> [Attribute]) -> Name -> [Attribute]
forall a b. (a -> b) -> a -> b
$ "<attributeDecl> unknown attribute reference "
Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
ref
Just a' :: AttributeDecl
a' -> AttributeDecl -> [Attribute]
attributeDecl AttributeDecl
a'
attrgroup :: XSD.AttrGroup -> [Haskell.Attribute]
attrgroup :: AttrGroup -> [Attribute]
attrgroup g :: AttrGroup
g = case AttrGroup -> Either Name QName
attrgroup_nameOrRef AttrGroup
g of
Left n :: Name
n -> (Either AttributeDecl AttrGroup -> [Attribute])
-> [Either AttributeDecl AttrGroup] -> [Attribute]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((AttributeDecl -> [Attribute])
-> (AttrGroup -> [Attribute])
-> Either AttributeDecl AttrGroup
-> [Attribute]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AttributeDecl -> [Attribute]
attributeDecl AttrGroup -> [Attribute]
attrgroup)
(AttrGroup -> [Either AttributeDecl AttrGroup]
attrgroup_stuff AttrGroup
g)
Right ref :: QName
ref -> case QName -> Map QName AttrGroup -> Maybe AttrGroup
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
ref (Environment -> Map QName AttrGroup
env_attrgroup Environment
env) of
Nothing -> Name -> [Attribute]
forall a. HasCallStack => Name -> a
error (Name -> [Attribute]) -> Name -> [Attribute]
forall a b. (a -> b) -> a -> b
$ "unknown attribute group reference "
Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
ref
Just g' :: AttrGroup
g' -> AttrGroup -> [Attribute]
attrgroup AttrGroup
g'
group :: XSD.Group -> [Haskell.Decl]
group :: Group -> [Decl]
group g :: Group
g = case Group -> Either Name QName
group_nameOrRef Group
g of
Left n :: Name
n -> let ([Element]
es) = ChoiceOrSeq -> [Element]
choiceOrSeq (ChoiceOrSeq -> Maybe ChoiceOrSeq -> ChoiceOrSeq
forall a. a -> Maybe a -> a
fromMaybe (Name -> ChoiceOrSeq
forall a. HasCallStack => Name -> a
error "XSD.group")
(Group -> Maybe ChoiceOrSeq
group_stuff Group
g))
in Decl -> [Decl]
forall a. a -> [a]
singleton (Decl -> [Decl]) -> Decl -> [Decl]
forall a b. (a -> b) -> a -> b
$
XName -> [Element] -> Maybe Name -> Decl
Haskell.Group (Name -> XName
xname Name
n)
((Element -> Element) -> [Element] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (\e :: Element
e->Element
e{elem_modifier :: Modifier
elem_modifier=
Occurs -> Modifier -> Modifier
combineOccursModifier
(Group -> Occurs
group_occurs Group
g)
(Element -> Modifier
elem_modifier Element
e)})
[Element]
es)
(Annotation -> Maybe Name
comment (Group -> Annotation
group_annotation Group
g))
Right ref :: QName
ref -> case QName -> Map QName Group -> Maybe Group
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
ref (Environment -> Map QName Group
env_group Environment
env) of
Nothing -> Decl -> [Decl]
forall a. a -> [a]
singleton (Decl -> [Decl]) -> Decl -> [Decl]
forall a b. (a -> b) -> a -> b
$
XName -> [Element] -> Maybe Name -> Decl
Haskell.Group (Name -> XName
xname ("unknown-group-"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++QName -> Name
printableName QName
ref)) []
(Annotation -> Maybe Name
comment (Group -> Annotation
group_annotation Group
g))
Just g' :: Group
g' -> Group -> [Decl]
group Group
g'{ group_occurs :: Occurs
group_occurs=Group -> Occurs
group_occurs Group
g }
particleAttrs :: ParticleAttrs -> ([Haskell.Element],[Haskell.Attribute])
particleAttrs :: ParticleAttrs -> ([Element], [Attribute])
particleAttrs (PA part :: Particle
part attrs :: [Either AttributeDecl AttrGroup]
attrs _) =
(Particle -> [Element]
particle Particle
part, (Either AttributeDecl AttrGroup -> [Attribute])
-> [Either AttributeDecl AttrGroup] -> [Attribute]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((AttributeDecl -> [Attribute])
-> (AttrGroup -> [Attribute])
-> Either AttributeDecl AttrGroup
-> [Attribute]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AttributeDecl -> [Attribute]
attributeDecl AttrGroup -> [Attribute]
attrgroup) [Either AttributeDecl AttrGroup]
attrs)
particle :: Particle -> [Haskell.Element]
particle :: Particle -> [Element]
particle Nothing = []
particle (Just (Left cs :: ChoiceOrSeq
cs)) = ChoiceOrSeq -> [Element]
choiceOrSeq ChoiceOrSeq
cs
particle (Just (Right g :: Group
g)) = let [Haskell.Group _ es :: [Element]
es _] = Group -> [Decl]
group Group
g in [Element]
es
choiceOrSeq :: ChoiceOrSeq -> [Haskell.Element]
choiceOrSeq :: ChoiceOrSeq -> [Element]
choiceOrSeq (XSD.All ann :: Annotation
ann eds :: [ElementDecl]
eds) = Name -> [Element]
forall a. HasCallStack => Name -> a
error "not yet implemented: XSD.All"
choiceOrSeq (XSD.Choice ann :: Annotation
ann o :: Occurs
o ees :: [ElementEtc]
ees) = [ [[Element]] -> Modifier -> Maybe Name -> Element
OneOf ([[Element]] -> [[Element]]
anyToEnd
((ElementEtc -> [Element]) -> [ElementEtc] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map ElementEtc -> [Element]
elementEtc [ElementEtc]
ees))
(Occurs -> Modifier
occursToModifier Occurs
o)
(Annotation -> Maybe Name
comment Annotation
ann) ]
choiceOrSeq (XSD.Sequence ann :: Annotation
ann _ ees :: [ElementEtc]
ees) = (ElementEtc -> [Element]) -> [ElementEtc] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElementEtc -> [Element]
elementEtc [ElementEtc]
ees
elementEtc :: ElementEtc -> [Haskell.Element]
elementEtc :: ElementEtc -> [Element]
elementEtc (HasElement ed :: ElementDecl
ed) = [ElementDecl -> Element
elementDecl ElementDecl
ed]
elementEtc (HasGroup g :: Group
g) = let [Haskell.Group _ es :: [Element]
es _] = Group -> [Decl]
group Group
g in [Element]
es
elementEtc (HasCS cs :: ChoiceOrSeq
cs) = ChoiceOrSeq -> [Element]
choiceOrSeq ChoiceOrSeq
cs
elementEtc (HasAny a :: Any
a) = Any -> [Element]
any Any
a
any :: XSD.Any -> [Haskell.Element]
any :: Any -> [Element]
any a :: Any
a@XSD.Any{} = [AnyElem :: Modifier -> Maybe Name -> Element
Haskell.AnyElem
{ elem_modifier :: Modifier
elem_modifier = Occurs -> Modifier
occursToModifier (Any -> Occurs
any_occurs Any
a)
, elem_comment :: Maybe Name
elem_comment = Annotation -> Maybe Name
comment (Any -> Annotation
any_annotation Any
a) }]
anyToEnd :: [[Haskell.Element]] -> [[Haskell.Element]]
anyToEnd :: [[Element]] -> [[Element]]
anyToEnd = Maybe [Element] -> [[Element]] -> [[Element]]
go Maybe [Element]
forall a. Maybe a
Nothing
where go :: Maybe [Element] -> [[Element]] -> [[Element]]
go _ (e :: [Element]
e@[AnyElem{}]:[]) = [Element]
e[Element] -> [[Element]] -> [[Element]]
forall a. a -> [a] -> [a]
:[]
go _ (e :: [Element]
e@[AnyElem{}]:es :: [[Element]]
es) = Maybe [Element] -> [[Element]] -> [[Element]]
go ([Element] -> Maybe [Element]
forall a. a -> Maybe a
Just [Element]
e) [[Element]]
es
go Nothing [] = []
go (Just e :: [Element]
e) [] = [Element]
e[Element] -> [[Element]] -> [[Element]]
forall a. a -> [a] -> [a]
:[]
go m :: Maybe [Element]
m (e :: [Element]
e:es :: [[Element]]
es) = [Element]
e[Element] -> [[Element]] -> [[Element]]
forall a. a -> [a] -> [a]
:Maybe [Element] -> [[Element]] -> [[Element]]
go Maybe [Element]
m [[Element]]
es
contentInfo :: Maybe (Either SimpleType ComplexType)
-> ([Haskell.Element],[Haskell.Attribute])
contentInfo :: Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
contentInfo Nothing = ([],[])
contentInfo (Just e :: Either SimpleType ComplexType
e) = (SimpleType -> ([Element], [Attribute]))
-> (ComplexType -> ([Element], [Attribute]))
-> Either SimpleType ComplexType
-> ([Element], [Attribute])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SimpleType -> ([Element], [Attribute])
simple ComplexType -> ([Element], [Attribute])
complex Either SimpleType ComplexType
e
where
simple :: SimpleType -> ([Element],[Attribute])
complex :: ComplexType -> ([Element],[Attribute])
simple :: SimpleType -> ([Element], [Attribute])
simple _ = ([], [])
complex :: ComplexType -> ([Element], [Attribute])
complex ct :: ComplexType
ct = case ComplexType -> ComplexItem
complex_content ComplexType
ct of
SimpleContent{} -> ([],[])
ci :: ComplexItem
ci@ComplexContent{} -> (Restriction1 -> ([Element], [Attribute]))
-> (Extension -> ([Element], [Attribute]))
-> Either Restriction1 Extension
-> ([Element], [Attribute])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Restriction1 -> ([Element], [Attribute])
restr Extension -> ([Element], [Attribute])
exten (ComplexItem -> Either Restriction1 Extension
ci_stuff ComplexItem
ci)
ThisType pa :: ParticleAttrs
pa -> ParticleAttrs -> ([Element], [Attribute])
particleAttrs ParticleAttrs
pa
restr :: Restriction1 -> ([Element],[Attribute])
exten :: Extension -> ([Element],[Attribute])
restr :: Restriction1 -> ([Element], [Attribute])
restr (Restriction1 p :: Particle
p) = (Particle -> [Element]
particle Particle
p,[])
exten :: Extension -> ([Element], [Attribute])
exten e :: Extension
e = let (oes :: [Element]
oes,oas :: [Attribute]
oas) = Maybe (Either SimpleType ComplexType) -> ([Element], [Attribute])
contentInfo (QName
-> Map QName (Either SimpleType ComplexType)
-> Maybe (Either SimpleType ComplexType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Extension -> QName
extension_base Extension
e)
(Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
env))
(nes :: [Element]
nes,nas :: [Attribute]
nas) = ParticleAttrs -> ([Element], [Attribute])
particleAttrs (Extension -> ParticleAttrs
extension_newstuff Extension
e)
in ([Element]
oes[Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++[Element]
nes, [Attribute]
oas[Attribute] -> [Attribute] -> [Attribute]
forall a. [a] -> [a] -> [a]
++[Attribute]
nas)
comment :: Annotation -> Comment
(Documentation s :: Name
s) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
s
comment (AppInfo s :: Name
s) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
s
comment (NoAnnotation _) = Maybe Name
forall a. Maybe a
Nothing
xname :: String -> XName
xname :: Name -> XName
xname = QName -> XName
XName (QName -> XName) -> (Name -> QName) -> Name -> XName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> QName
N
checkXName :: Schema -> QName -> XName
checkXName :: Schema -> QName -> XName
checkXName s :: Schema
s n :: QName
n@(N _) = QName -> XName
XName QName
n
checkXName s :: Schema
s n :: QName
n@(QN ns :: Namespace
ns m :: Name
m) | (Just uri :: Name
uri) <- Schema -> Maybe Name
schema_targetNamespace Schema
s
, Namespace -> Name
nsURI Namespace
ns Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
uri = QName -> XName
XName (QName -> XName) -> QName -> XName
forall a b. (a -> b) -> a -> b
$ Name -> QName
N Name
m
| Bool
otherwise = QName -> XName
XName QName
n
nameOfSimple :: SimpleType -> XName
nameOfSimple :: SimpleType -> XName
nameOfSimple (Primitive prim :: PrimitiveType
prim) = QName -> XName
XName (QName -> XName)
-> (PrimitiveType -> QName) -> PrimitiveType -> XName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> QName
xsd (Name -> QName)
-> (PrimitiveType -> Name) -> PrimitiveType -> QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimitiveType -> Name
forall a. Show a => a -> Name
show (PrimitiveType -> XName) -> PrimitiveType -> XName
forall a b. (a -> b) -> a -> b
$ PrimitiveType
prim
nameOfSimple (Restricted _ (Just n :: Name
n) _ _) = Name -> XName
xname Name
n
nameOfSimple (ListOf _ (Just n :: Name
n) _ _) = Name -> XName
xname Name
n
nameOfSimple (UnionOf _ (Just n :: Name
n) _ _ _) = Name -> XName
xname Name
n
nameOfSimple s :: SimpleType
s = Name -> XName
xname "String"
mkRestrict :: XSD.Restriction -> [Haskell.Restrict]
mkRestrict :: Restriction -> [Restrict]
mkRestrict (RestrictSim1 ann :: Annotation
ann base :: Maybe QName
base r1 :: Restriction1
r1) = []
mkRestrict (RestrictType _ _ _ facets :: [Facet]
facets) =
(let occurs :: [(FacetType, Annotation, Name)]
occurs = [ (FacetType
f,Annotation
ann,Name
v) | (Facet f :: FacetType
f ann :: Annotation
ann v :: Name
v _) <- [Facet]
facets
, FacetType
f FacetType -> [FacetType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FacetType
OrderedBoundsMinIncl
,FacetType
OrderedBoundsMinExcl
,FacetType
OrderedBoundsMaxIncl
,FacetType
OrderedBoundsMaxExcl] ]
in if [(FacetType, Annotation, Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FacetType, Annotation, Name)]
occurs then []
else [Occurs -> Maybe Name -> Restrict
Haskell.RangeR ((Occurs -> (FacetType, Annotation, Name) -> Occurs)
-> Occurs -> [(FacetType, Annotation, Name)] -> Occurs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Occurs -> (FacetType, Annotation, Name) -> Occurs
consolidate (Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing) [(FacetType, Annotation, Name)]
occurs)
(Annotation -> Maybe Name
comment (Annotation -> Maybe Name) -> Annotation -> Maybe Name
forall a b. (a -> b) -> a -> b
$ (Annotation -> Annotation -> Annotation)
-> Annotation -> [Annotation] -> Annotation
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
mappend Annotation
forall a. Monoid a => a
mempty
[ Annotation
ann | (_,ann :: Annotation
ann,_) <- [(FacetType, Annotation, Name)]
occurs])]
) [Restrict] -> [Restrict] -> [Restrict]
forall a. [a] -> [a] -> [a]
++
[ Name -> Maybe Name -> Restrict
Haskell.Pattern Name
v (Annotation -> Maybe Name
comment Annotation
ann)
| (Facet UnorderedPattern ann :: Annotation
ann v :: Name
v _) <- [Facet]
facets ]
[Restrict] -> [Restrict] -> [Restrict]
forall a. [a] -> [a] -> [a]
++
(let enum :: [(Name, Maybe Name)]
enum = [ (Name
v,Annotation -> Maybe Name
comment Annotation
ann)
| (Facet UnorderedEnumeration ann :: Annotation
ann v :: Name
v _) <- [Facet]
facets ]
in if [(Name, Maybe Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Maybe Name)]
enum then []
else [[(Name, Maybe Name)] -> Restrict
Haskell.Enumeration [(Name, Maybe Name)]
enum]
) [Restrict] -> [Restrict] -> [Restrict]
forall a. [a] -> [a] -> [a]
++
(let occurs :: [(FacetType, Annotation, Name)]
occurs = [ (FacetType
f,Annotation
ann,Name
v) | (Facet f :: FacetType
f ann :: Annotation
ann v :: Name
v _) <- [Facet]
facets
, FacetType
f FacetType -> [FacetType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FacetType
UnorderedLength
,FacetType
UnorderedMaxLength
,FacetType
UnorderedMinLength] ]
in if [(FacetType, Annotation, Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FacetType, Annotation, Name)]
occurs then []
else [Occurs -> Maybe Name -> Restrict
Haskell.StrLength
((Occurs -> (FacetType, Annotation, Name) -> Occurs)
-> Occurs -> [(FacetType, Annotation, Name)] -> Occurs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Occurs -> (FacetType, Annotation, Name) -> Occurs
consolidate (Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing) [(FacetType, Annotation, Name)]
occurs)
(Annotation -> Maybe Name
comment (Annotation -> Maybe Name) -> Annotation -> Maybe Name
forall a b. (a -> b) -> a -> b
$ (Annotation -> Annotation -> Annotation)
-> Annotation -> [Annotation] -> Annotation
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Annotation -> Annotation -> Annotation
forall a. Monoid a => a -> a -> a
mappend Annotation
forall a. Monoid a => a
mempty [ Annotation
ann | (_,ann :: Annotation
ann,_) <- [(FacetType, Annotation, Name)]
occurs])]
)
singleton :: a -> [a]
singleton :: a -> [a]
singleton = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])
consolidate :: Occurs -> (FacetType,Annotation,String) -> Occurs
consolidate :: Occurs -> (FacetType, Annotation, Name) -> Occurs
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (OrderedBoundsMinIncl,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n)) Maybe Int
max
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (OrderedBoundsMinExcl,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just ((Name -> Int
forall a. Read a => Name -> a
read Name
n)Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)) Maybe Int
max
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (OrderedBoundsMaxIncl,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
min (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n))
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (OrderedBoundsMaxExcl,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
min (Int -> Maybe Int
forall a. a -> Maybe a
Just ((Name -> Int
forall a. Read a => Name -> a
read Name
n)Int -> Int -> Int
forall a. Num a => a -> a -> a
-1))
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (UnorderedLength,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n)) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n))
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (UnorderedMinLength,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n)) Maybe Int
max
consolidate (Occurs min :: Maybe Int
min max :: Maybe Int
max) (UnorderedMaxLength,_,n :: Name
n) =
Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
min (Int -> Maybe Int
forall a. a -> Maybe a
Just (Name -> Int
forall a. Read a => Name -> a
read Name
n))
instance Monoid Occurs where
mempty :: Occurs
mempty = Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
mappend :: Occurs -> Occurs -> Occurs
mappend = Occurs -> Occurs -> Occurs
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup Occurs where
(Occurs Nothing Nothing) <> :: Occurs -> Occurs -> Occurs
<> o :: Occurs
o = Occurs
o
(Occurs (Just z :: Int
z) Nothing) <> (Occurs min :: Maybe Int
min max :: Maybe Int
max)
= Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
z (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
z) Maybe Int
min) Maybe Int
max
(Occurs Nothing (Just x :: Int
x)) <> (Occurs min :: Maybe Int
min max :: Maybe Int
max)
= Maybe Int -> Maybe Int -> Occurs
Occurs Maybe Int
min (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
x (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x) Maybe Int
max)
(Occurs (Just z :: Int
z) (Just x :: Int
x)) <> (Occurs min :: Maybe Int
min max :: Maybe Int
max)
= Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
z (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
z) Maybe Int
min)
(Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
x (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x) Maybe Int
max)
combineOccursModifier :: Occurs -> Modifier -> Modifier
combineOccursModifier :: Occurs -> Modifier -> Modifier
combineOccursModifier o :: Occurs
o Haskell.Single = Occurs -> Modifier
occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
forall a b. (a -> b) -> a -> b
$ Occurs -> Occurs -> Occurs
forall a. Monoid a => a -> a -> a
mappend Occurs
o
(Occurs -> Occurs) -> Occurs -> Occurs
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just 1) (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
combineOccursModifier o :: Occurs
o Haskell.Optional = Occurs -> Modifier
occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
forall a b. (a -> b) -> a -> b
$ Occurs -> Occurs -> Occurs
forall a. Monoid a => a -> a -> a
mappend Occurs
o
(Occurs -> Occurs) -> Occurs -> Occurs
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Occurs
Occurs (Int -> Maybe Int
forall a. a -> Maybe a
Just 0) (Int -> Maybe Int
forall a. a -> Maybe a
Just 1)
combineOccursModifier o :: Occurs
o (Haskell.Range o' :: Occurs
o') = Occurs -> Modifier
occursToModifier (Occurs -> Modifier) -> Occurs -> Modifier
forall a b. (a -> b) -> a -> b
$ Occurs -> Occurs -> Occurs
forall a. Monoid a => a -> a -> a
mappend Occurs
o Occurs
o'
occursToModifier :: Occurs -> Modifier
occursToModifier :: Occurs -> Modifier
occursToModifier (Occurs Nothing Nothing) = Modifier
Haskell.Single
occursToModifier (Occurs (Just 0) Nothing) = Modifier
Haskell.Optional
occursToModifier (Occurs (Just 0) (Just 1)) = Modifier
Haskell.Optional
occursToModifier (Occurs (Just 1) (Just 1)) = Modifier
Haskell.Single
occursToModifier o :: Occurs
o = Occurs -> Modifier
Haskell.Range Occurs
o
supertypeOf :: Environment -> QName -> Maybe QName
supertypeOf :: Environment -> QName -> Maybe QName
supertypeOf env :: Environment
env t :: QName
t =
do Either SimpleType ComplexType
typ <- QName
-> Map QName (Either SimpleType ComplexType)
-> Maybe (Either SimpleType ComplexType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QName
t (Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
env)
ComplexItem
a <- (SimpleType -> Maybe ComplexItem)
-> (ComplexType -> Maybe ComplexItem)
-> Either SimpleType ComplexType
-> Maybe ComplexItem
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ComplexItem -> SimpleType -> Maybe ComplexItem
forall a b. a -> b -> a
const Maybe ComplexItem
forall a. Maybe a
Nothing) (ComplexItem -> Maybe ComplexItem
forall a. a -> Maybe a
Just (ComplexItem -> Maybe ComplexItem)
-> (ComplexType -> ComplexItem) -> ComplexType -> Maybe ComplexItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComplexType -> ComplexItem
complex_content) Either SimpleType ComplexType
typ
Either Restriction1 Extension
b <- case ComplexItem
a of ComplexContent{} -> Either Restriction1 Extension
-> Maybe (Either Restriction1 Extension)
forall a. a -> Maybe a
Just (ComplexItem -> Either Restriction1 Extension
ci_stuff ComplexItem
a)
_ -> Maybe (Either Restriction1 Extension)
forall a. Maybe a
Nothing
(Restriction1 -> Maybe QName)
-> (Extension -> Maybe QName)
-> Either Restriction1 Extension
-> Maybe QName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe QName -> Restriction1 -> Maybe QName
forall a b. a -> b -> a
const Maybe QName
forall a. Maybe a
Nothing) (QName -> Maybe QName
forall a. a -> Maybe a
Just (QName -> Maybe QName)
-> (Extension -> QName) -> Extension -> Maybe QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> QName
extension_base) Either Restriction1 Extension
b
repeatedly :: (a->Maybe a) -> a -> [a]
repeatedly :: (a -> Maybe a) -> a -> [a]
repeatedly f :: a -> Maybe a
f x :: a
x = case a -> Maybe a
f a
x of Nothing -> []
Just y :: a
y -> a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Maybe a) -> a -> [a]
forall a. (a -> Maybe a) -> a -> [a]
repeatedly a -> Maybe a
f a
y