{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module Text.XML.HXT.Arrow.Pickle.DTD
where
import Data.Maybe
import qualified Text.XML.HXT.DOM.XmlNode as XN
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.Pickle.Schema
import Text.XML.HXT.XMLSchema.DataTypeLibW3CNames
data DTDdescr = DTDdescr Name Schemas [(Name,Schemas)]
instance Show DTDdescr where
show :: DTDdescr -> String
show (DTDdescr String
n Schemas
es [(String, Schemas)]
as)
= String
"root element: " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++
String
"elements:\n"
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall a. [a] -> [a] -> [a]
++ String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show) Schemas
es
forall a. [a] -> [a] -> [a]
++
String
"attributes:\n"
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall a. [a] -> [a] -> [a]
++ String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => (String, a) -> String
showAttr) [(String, Schemas)]
as
where
showAttr :: (String, a) -> String
showAttr (String
n1, a
sc) = String
n1 forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
sc
dtdDescrToXml :: DTDdescr -> XmlTrees
dtdDescrToXml :: DTDdescr -> XmlTrees
dtdDescrToXml (DTDdescr String
rt Schemas
es [(String, Schemas)]
as)
= Bool -> String -> XmlTrees
checkErr (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rt) String
"no unique root element found in pickler DTD, add an \"xpElem\" pickler"
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> String -> XmlTrees
checkErr Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"no element decl found in: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScElem) Schemas
es)
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Schema -> XmlTrees
checkContentModell forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ (Element String
n Schema
sc) -> (String
n,Schema
sc)) Schemas
es1
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Schemas -> XmlTrees
checkAttrModell) [(String, Schemas)]
as
forall a. [a] -> [a] -> [a]
++
[ DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
DOCTYPE Attributes
docAttrs ( forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Schema -> XmlTrees
elemDTD Schemas
es1
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {t :: * -> *}. Foldable t => String -> t Schema -> XmlTrees
attrDTDs) [(String, Schemas)]
as
) ]
where
es1 :: Schemas
es1 = forall a. (a -> Bool) -> [a] -> [a]
filter Schema -> Bool
isScElem Schemas
es
docAttrs :: Attributes
docAttrs = [(String
a_name, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rt then String
"no-unique-root-element-found" else String
rt)]
elemDTD :: Schema -> XmlTrees
elemDTD (Element String
n Schema
sc)
| forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al forall a. Eq a => a -> a -> Bool
== String
"unknown"
= XmlTrees
cl
| Bool
otherwise
= [ DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
ELEMENT ((String
a_name, String
n) forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl ]
where
(Attributes
al, XmlTrees
cl) = Schema -> (Attributes, XmlTrees)
scContToXml Schema
sc
elemDTD Schema
_
= forall a. HasCallStack => String -> a
error String
"illegal case in elemDTD"
attrDTDs :: String -> t Schema -> XmlTrees
attrDTDs String
en = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
attrDTD String
en)
attrDTD :: String -> Schema -> XmlTrees
attrDTD String
en (Attribute String
an Schema
sc)
= [ DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
ATTLIST ((String
a_name, String
en) forall a. a -> [a] -> [a]
: (String
a_value, String
an) forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl ]
where
(Attributes
al, XmlTrees
cl) = Schema -> (Attributes, XmlTrees)
scAttrToXml Schema
sc
attrDTD String
_ Schema
_ = forall a. HasCallStack => String -> a
error String
"illegal case in attrDTD"
checkAttrModell :: Name -> Schemas -> XmlTrees
checkAttrModell :: String -> Schemas -> XmlTrees
checkAttrModell String
n = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
checkAM String
n)
checkAM :: Name -> Schema -> XmlTrees
checkAM :: String -> Schema -> XmlTrees
checkAM String
en (Attribute String
an Schema
sc) = String -> String -> Schema -> XmlTrees
checkAMC String
en String
an Schema
sc
checkAM String
_ Schema
_ = []
checkAMC :: Name -> Name -> Schema -> XmlTrees
checkAMC :: String -> String -> Schema -> XmlTrees
checkAMC String
_en String
_an (CharData DataTypeDescr
_) = []
checkAMC String
en String
an Schema
sc
| Schema -> Bool
isScCharData Schema
sc = []
| Schema -> Bool
isScList Schema
sc
Bool -> Bool -> Bool
&&
(Schema -> Schema
sc_1 Schema
sc forall a. Eq a => a -> a -> Bool
== Schema
scNmtoken)
= []
| Schema -> Bool
isScOpt Schema
sc = String -> String -> Schema -> XmlTrees
checkAMC String
en String
an (Schema -> Schema
sc_1 Schema
sc)
| Bool
otherwise = String -> XmlTrees
foundErr
( String
"weird attribute type found for attribute "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
an
forall a. [a] -> [a] -> [a]
++ String
" for element "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
en
forall a. [a] -> [a] -> [a]
++ String
"\n\t(internal structure: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Schema
sc forall a. [a] -> [a] -> [a]
++ String
")"
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element instead of an attribute for "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
an
)
checkContentModell :: Name -> Schema -> XmlTrees
checkContentModell :: String -> Schema -> XmlTrees
checkContentModell String
_ Schema
Any
= []
checkContentModell String
_ (ElemRef String
_)
= []
checkContentModell String
_ (CharData DataTypeDescr
_)
= []
checkContentModell String
_ (Seq [])
= []
checkContentModell String
n (Seq Schemas
scs)
= Bool -> String -> XmlTrees
checkErr Bool
pcDataInCM
( String
"PCDATA found in a sequence spec in the content modell for "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element for this data"
)
forall a. [a] -> [a] -> [a]
++
Bool -> String -> XmlTrees
checkErr Bool
somethingElseInCM
( String
"something weired found in a sequence spec in the content modell for "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n
)
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
checkContentModell String
n) Schemas
scs
where
pcDataInCM :: Bool
pcDataInCM = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Schema -> Bool
isScCharData Schemas
scs
somethingElseInCM :: Bool
somethingElseInCM = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ Schema
sc -> Bool -> Bool
not (Schema -> Bool
isScSARE Schema
sc) Bool -> Bool -> Bool
&& Bool -> Bool
not (Schema -> Bool
isScCharData Schema
sc)) Schemas
scs
checkContentModell String
n (Alt Schemas
scs)
= Bool -> String -> XmlTrees
checkErr Bool
mixedCM
( String
"PCDATA mixed up with illegal content spec in mixed contents for "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element for this data"
)
forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
checkContentModell String
n) Schemas
scs
where
mixedCM :: Bool
mixedCM
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Schema -> Bool
isScCharData Schemas
scs
= forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScElemRef) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScCharData) forall a b. (a -> b) -> a -> b
$ Schemas
scs
| Bool
otherwise
= Bool
False
checkContentModell String
_ (Rep Int
_ Int
_ (ElemRef String
_))
= []
checkContentModell String
n (Rep Int
_ Int
_ sc :: Schema
sc@(Seq Schemas
_))
= String -> Schema -> XmlTrees
checkContentModell String
n Schema
sc
checkContentModell String
n (Rep Int
_ Int
_ sc :: Schema
sc@(Alt Schemas
_))
= String -> Schema -> XmlTrees
checkContentModell String
n Schema
sc
checkContentModell String
n (Rep Int
_ Int
_ Schema
_)
= String -> XmlTrees
foundErr
( String
"illegal content spec found for "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n
)
checkContentModell String
_ Schema
_
= []
scContToXml :: Schema -> (Attributes, XmlTrees)
scContToXml :: Schema -> (Attributes, XmlTrees)
scContToXml Schema
Any = ( [(String
a_type, String
v_any)], [] )
scContToXml (CharData DataTypeDescr
_) = ( [(String
a_type, String
v_pcdata)], [] )
scContToXml (Seq []) = ( [(String
a_type, String
v_empty)], [] )
scContToXml sc :: Schema
sc@(ElemRef String
_) = Schema -> (Attributes, XmlTrees)
scContToXml (Schemas -> Schema
Seq [Schema
sc])
scContToXml sc :: Schema
sc@(Seq Schemas
_) = ( [(String
a_type, String
v_children)]
, Attributes -> Schema -> XmlTrees
scCont [] Schema
sc
)
scContToXml sc :: Schema
sc@(Alt Schemas
sc1)
| Schemas -> Bool
isMixed Schemas
sc1 = ( [(String
a_type, String
v_mixed)]
, Attributes -> Schema -> XmlTrees
scCont [ (String
a_modifier, String
"*") ] Schema
sc
)
| Bool
otherwise = ( [(String
a_type, String
v_children)]
, Attributes -> Schema -> XmlTrees
scCont [] Schema
sc
)
where
isMixed :: Schemas -> Bool
isMixed = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Schema -> Bool
isScCharData
scContToXml sc :: Schema
sc@(Rep Int
_ Int
_ Schema
_) = ( [(String
a_type, String
v_children)]
, Attributes -> Schema -> XmlTrees
scCont [] Schema
sc
)
scContToXml Schema
_sc = ( [(String
a_type, String
v_any)]
, []
)
scWrap :: Schema -> Schema
scWrap :: Schema -> Schema
scWrap sc :: Schema
sc@(Alt Schemas
_) = Schema
sc
scWrap sc :: Schema
sc@(Seq Schemas
_) = Schema
sc
scWrap sc :: Schema
sc@(Rep Int
_ Int
_ Schema
_) = Schema
sc
scWrap Schema
sc = Schemas -> Schema
Seq [Schema
sc]
scCont :: Attributes -> Schema -> XmlTrees
scCont :: Attributes -> Schema -> XmlTrees
scCont Attributes
al (Seq Schemas
scs) = Attributes -> Schemas -> XmlTrees
scConts ((String
a_kind, String
v_seq ) forall a. a -> [a] -> [a]
: Attributes
al) Schemas
scs
scCont Attributes
al (Alt Schemas
scs) = Attributes -> Schemas -> XmlTrees
scConts ((String
a_kind, String
v_choice) forall a. a -> [a] -> [a]
: Attributes
al) Schemas
scs
scCont Attributes
al (Rep Int
0 (-1) Schema
sc) = Attributes -> Schema -> XmlTrees
scCont ((String
a_modifier, String
"*") forall a. a -> [a] -> [a]
: Attributes
al) (Schema -> Schema
scWrap Schema
sc)
scCont Attributes
al (Rep Int
1 (-1) Schema
sc) = Attributes -> Schema -> XmlTrees
scCont ((String
a_modifier, String
"+") forall a. a -> [a] -> [a]
: Attributes
al) (Schema -> Schema
scWrap Schema
sc)
scCont Attributes
al (Rep Int
0 Int
1 Schema
sc) = Attributes -> Schema -> XmlTrees
scCont ((String
a_modifier, String
"?") forall a. a -> [a] -> [a]
: Attributes
al) (Schema -> Schema
scWrap Schema
sc)
scCont Attributes
al (ElemRef String
n) = [DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
NAME ((String
a_name, String
n) forall a. a -> [a] -> [a]
: Attributes
al) []]
scCont Attributes
_ (CharData DataTypeDescr
_) = [DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
NAME [(String
a_name, String
"#PCDATA")] []]
scCont Attributes
_ Schema
_sc = [DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
NAME [(String
a_name, String
"bad-content-spec")] []]
scConts :: Attributes -> Schemas -> XmlTrees
scConts :: Attributes -> Schemas -> XmlTrees
scConts Attributes
al Schemas
scs = [DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
CONTENT Attributes
al (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Attributes -> Schema -> XmlTrees
scCont []) Schemas
scs)]
scAttrToXml :: Schema -> (Attributes, XmlTrees)
scAttrToXml :: Schema -> (Attributes, XmlTrees)
scAttrToXml Schema
sc
| Schema -> Bool
isScFixed Schema
sc = ( [ (String
a_kind, String
k_fixed)
, (String
a_type, String
k_cdata)
, (String
a_default, (String -> Schema -> String
xsdParam String
xsd_enumeration Schema
sc))
]
, [])
| Schema -> Bool
isScEnum Schema
sc = ( [ (String
a_kind, String
k_required)
, (String
a_type, String
k_enumeration)
]
, forall a b. (a -> b) -> [a] -> [b]
map (\ String
n -> DTDElem -> Attributes -> XmlTrees -> NTree XNode
XN.mkDTDElem DTDElem
NAME [(String
a_name, String
n)] []) [String]
enums
)
| Schema -> Bool
isScCharData Schema
sc = ( [ (String
a_kind, String
k_required)
, (String
a_type, String
d_type)
]
, [])
| Schema -> Bool
isScOpt Schema
sc = (forall k v. Eq k => k -> v -> AssocList k v -> AssocList k v
addEntry String
a_kind String
k_implied Attributes
al, XmlTrees
cl)
| Schema -> Bool
isScList Schema
sc = (forall k v. Eq k => k -> v -> AssocList k v -> AssocList k v
addEntry String
a_type String
k_nmtokens Attributes
al, XmlTrees
cl)
| Bool
otherwise = ( [ (String
a_kind, String
k_fixed)
, (String
a_default, String
"bad-attribute-type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Schema
sc)
]
, [] )
where
(Attributes
al, XmlTrees
cl) = Schema -> (Attributes, XmlTrees)
scAttrToXml (Schema -> Schema
sc_1 Schema
sc)
d_type :: String
d_type
| Schema
sc forall a. Eq a => a -> a -> Bool
== Schema
scNmtoken = String
k_nmtoken
| Bool
otherwise = String
k_cdata
enums :: [String]
enums = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Schema -> String
xsdParam String
xsd_enumeration forall a b. (a -> b) -> a -> b
$ Schema
sc
checkErr :: Bool -> String -> XmlTrees
checkErr :: Bool -> String -> XmlTrees
checkErr Bool
True String
s = [forall a. XmlNode a => Int -> String -> a
XN.mkError Int
c_err String
s]
checkErr Bool
_ String
_ = []
foundErr :: String -> XmlTrees
foundErr :: String -> XmlTrees
foundErr = Bool -> String -> XmlTrees
checkErr Bool
True
dtdDescr :: Schema -> DTDdescr
dtdDescr :: Schema -> DTDdescr
dtdDescr Schema
sc
= String -> Schemas -> [(String, Schemas)] -> DTDdescr
DTDdescr String
rt Schemas
es1 [(String, Schemas)]
as
where
es :: Schemas
es = Schema -> Schemas
elementDeclarations Schema
sc
es1 :: Schemas
es1 = forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
remAttrDec Schemas
es
as :: [(String, Schemas)]
as = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Schema -> [(String, Schemas)]
attrDec forall a b. (a -> b) -> a -> b
$ Schemas
es
rt :: String
rt = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Maybe String
elemName forall a b. (a -> b) -> a -> b
$ Schema
sc
elementDeclarations :: Schema -> Schemas
elementDeclarations :: Schema -> Schemas
elementDeclarations Schema
sc = Schemas -> Schemas
elemRefs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schemas -> Schemas -> Schemas
elementDecs [] forall a b. (a -> b) -> a -> b
$ [Schema
sc]
elementDecs :: Schemas -> Schemas -> Schemas
elementDecs :: Schemas -> Schemas -> Schemas
elementDecs Schemas
es []
= Schemas
es
elementDecs Schemas
es (Schema
s:Schemas
ss)
= Schemas -> Schemas -> Schemas
elementDecs (Schema -> Schemas
elemDecs Schema
s) Schemas
ss
where
elemDecs :: Schema -> Schemas
elemDecs (Seq Schemas
scs) = Schemas -> Schemas -> Schemas
elementDecs Schemas
es Schemas
scs
elemDecs (Alt Schemas
scs) = Schemas -> Schemas -> Schemas
elementDecs Schemas
es Schemas
scs
elemDecs (Rep Int
_ Int
_ Schema
sc) = Schema -> Schemas
elemDecs Schema
sc
elemDecs e :: Schema
e@(Element String
n Schema
sc)
| String
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Schemas -> [String]
elemNames Schemas
es = Schemas
es
| Bool
otherwise = Schemas -> Schemas -> Schemas
elementDecs (Schema
eforall a. a -> [a] -> [a]
:Schemas
es) [Schema
sc]
elemDecs Schema
_ = Schemas
es
elemNames :: Schemas -> [Name]
elemNames :: Schemas -> [String]
elemNames = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Maybe String
elemName)
elemName :: Schema -> Maybe Name
elemName :: Schema -> Maybe String
elemName (Element String
n Schema
_) = forall a. a -> Maybe a
Just String
n
elemName Schema
_ = forall a. Maybe a
Nothing
elemRefs :: Schemas -> Schemas
elemRefs :: Schemas -> Schemas
elemRefs = forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
elemRef
where
elemRef :: Schema -> Schema
elemRef (Element String
n Schema
sc) = String -> Schema -> Schema
Element String
n (Schema -> Schema
pruneElem Schema
sc)
elemRef Schema
sc = Schema
sc
pruneElem :: Schema -> Schema
pruneElem (Element String
n Schema
_) = String -> Schema
ElemRef String
n
pruneElem (Seq Schemas
scs) = Schemas -> Schema
Seq (forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
pruneElem Schemas
scs)
pruneElem (Alt Schemas
scs) = Schemas -> Schema
Alt (forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
pruneElem Schemas
scs)
pruneElem (Rep Int
l Int
u Schema
sc) = Int -> Int -> Schema -> Schema
Rep Int
l Int
u (Schema -> Schema
pruneElem Schema
sc)
pruneElem Schema
sc = Schema
sc
attrDec :: Schema -> [(Name, Schemas)]
attrDec :: Schema -> [(String, Schemas)]
attrDec (Element String
n Schema
sc)
= [(String
n, Schema -> Schemas
attrDecs Schema
sc)]
where
attrDecs :: Schema -> Schemas
attrDecs a :: Schema
a@(Attribute String
_ Schema
_) = [Schema
a]
attrDecs (Seq Schemas
scs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Schema -> Schemas
attrDecs Schemas
scs
attrDecs Schema
_ = []
attrDec Schema
_ = []
remAttrDec :: Schema -> Schema
remAttrDec :: Schema -> Schema
remAttrDec (Element String
n Schema
sc)
= String -> Schema -> Schema
Element String
n (Schema -> Schema
remA Schema
sc)
where
remA :: Schema -> Schema
remA (Attribute String
_ Schema
_) = Schema
scEmpty
remA (Seq Schemas
scs) = Schemas -> Schema
scSeqs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
remA forall a b. (a -> b) -> a -> b
$ Schemas
scs
remA Schema
sc1 = Schema
sc1
remAttrDec Schema
_
= forall a. HasCallStack => String -> a
error String
"illegal case in remAttrDec"