{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

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

{- |
   Module     : Text.XML.HXT.Arrow.Pickle.DTD
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable
   Version    : $Id$

Functions for converting a pickler schema
into a DTD

-}

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

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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"elements:\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++
          (Schema -> String) -> Schemas -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") ShowS -> (Schema -> String) -> Schema -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Schema -> String
forall a. Show a => a -> String
show) Schemas
es
          String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"attributes:\n"
          String -> ShowS
forall a. [a] -> [a] -> [a]
++
          ((String, Schemas) -> String) -> [(String, Schemas)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") ShowS
-> ((String, Schemas) -> String) -> (String, Schemas) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Schemas) -> String
forall a. Show a => (String, a) -> String
showAttr) [(String, Schemas)]
as
        where
        showAttr :: (String, a) -> String
showAttr (String
n1, a
sc) = String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
sc

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

-- | convert a DTD descr into XmlTrees

dtdDescrToXml   :: DTDdescr -> XmlTrees
dtdDescrToXml :: DTDdescr -> XmlTrees
dtdDescrToXml (DTDdescr String
rt Schemas
es [(String, Schemas)]
as)
    = Bool -> String -> XmlTrees
checkErr (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rt) String
"no unique root element found in pickler DTD, add an \"xpElem\" pickler"
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      (Schema -> XmlTrees) -> Schemas -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> String -> XmlTrees
checkErr Bool
True (String -> XmlTrees) -> (Schema -> String) -> Schema -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"no element decl found in: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Schema -> String) -> Schema -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> String
forall a. Show a => a -> String
show) ((Schema -> Bool) -> Schemas -> Schemas
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Schema -> Bool) -> Schema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScElem) Schemas
es)
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      (Schema -> XmlTrees) -> Schemas -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> Schema -> XmlTrees) -> (String, Schema) -> XmlTrees
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Schema -> XmlTrees
checkContentModell ((String, Schema) -> XmlTrees)
-> (Schema -> (String, Schema)) -> Schema -> XmlTrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \ (Element String
n Schema
sc) -> (String
n,Schema
sc)) Schemas
es1
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      ((String, Schemas) -> XmlTrees) -> [(String, Schemas)] -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> Schemas -> XmlTrees) -> (String, Schemas) -> XmlTrees
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Schemas -> XmlTrees
checkAttrModell) [(String, Schemas)]
as
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      [ DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
DOCTYPE Attributes
docAttrs ( (Schema -> XmlTrees) -> Schemas -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Schema -> XmlTrees
elemDTD Schemas
es1
                                        XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
                                        ((String, Schemas) -> XmlTrees) -> [(String, Schemas)] -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> Schemas -> XmlTrees) -> (String, Schemas) -> XmlTrees
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Schemas -> XmlTrees
forall (t :: * -> *). Foldable t => String -> t Schema -> XmlTrees
attrDTDs) [(String, Schemas)]
as
                                      ) ]
    where
    es1 :: Schemas
es1                 = (Schema -> Bool) -> Schemas -> Schemas
forall a. (a -> Bool) -> [a] -> [a]
filter Schema -> Bool
isScElem Schemas
es

    docAttrs :: Attributes
docAttrs            = [(String
a_name, if String -> Bool
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)
        | String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type Attributes
al String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"unknown"
            = XmlTrees
cl
        | Bool
otherwise
            = [ DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
ELEMENT ((String
a_name, String
n) (String, String) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl ]
        where
        (Attributes
al, XmlTrees
cl) = Schema -> (Attributes, XmlTrees)
scContToXml Schema
sc
    elemDTD Schema
_
        = String -> XmlTrees
forall a. HasCallStack => String -> a
error String
"illegal case in elemDTD"

    attrDTDs :: String -> t Schema -> XmlTrees
attrDTDs String
en         = (Schema -> XmlTrees) -> t Schema -> XmlTrees
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 -> XmlTree
XN.mkDTDElem DTDElem
ATTLIST ((String
a_name, String
en) (String, String) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: (String
a_value, String
an) (String, String) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) XmlTrees
cl ]
                          where
                          (Attributes
al, XmlTrees
cl) = Schema -> (Attributes, XmlTrees)
scAttrToXml Schema
sc
    attrDTD String
_ Schema
_         = String -> XmlTrees
forall a. HasCallStack => String -> a
error String
"illegal case in attrDTD"


checkAttrModell                                 :: Name -> Schemas -> XmlTrees
checkAttrModell :: String -> Schemas -> XmlTrees
checkAttrModell String
n                               = (Schema -> XmlTrees) -> Schemas -> XmlTrees
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 Schema -> Schema -> Bool
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 "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
an
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for element "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
en
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\t(internal structure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Schema -> String
forall a. Show a => a -> String
show Schema
sc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element instead of an attribute for "
                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
an
                          )

-- checkContentModell1 n sc = foundErr (n ++ " : " ++ show sc) ++ checkContentModell n sc

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 "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element for this data"
      )
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      Bool -> String -> XmlTrees
checkErr Bool
somethingElseInCM
      ( String
"something weired found in a sequence spec in the content modell for "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n
      )
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      (Schema -> XmlTrees) -> Schemas -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
checkContentModell String
n) Schemas
scs
    where
    pcDataInCM :: Bool
pcDataInCM        = (Schema -> Bool) -> Schemas -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Schema -> Bool
isScCharData Schemas
scs
    somethingElseInCM :: Bool
somethingElseInCM = (Schema -> Bool) -> Schemas -> Bool
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 "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\thint: create an element for this data"
      )
      XmlTrees -> XmlTrees -> XmlTrees
forall a. [a] -> [a] -> [a]
++
      (Schema -> XmlTrees) -> Schemas -> XmlTrees
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Schema -> XmlTrees
checkContentModell String
n) Schemas
scs
    where
    mixedCM :: Bool
mixedCM
        | (Schema -> Bool) -> Schemas -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Schema -> Bool
isScCharData Schemas
scs
            = (Schema -> Bool) -> Schemas -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Schema -> Bool) -> Schema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScElemRef) (Schemas -> Bool) -> (Schemas -> Schemas) -> Schemas -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Bool) -> Schemas -> Schemas
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Schema -> Bool) -> Schema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isScCharData) (Schemas -> Bool) -> Schemas -> Bool
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 "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
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 (Bool -> Bool) -> (Schemas -> Bool) -> Schemas -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schemas -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Schemas -> Bool) -> (Schemas -> Schemas) -> Schemas -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Bool) -> Schemas -> Schemas
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)]           -- default: everything is allowed
                                  , []
                                  )

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   ) (String, String) -> Attributes -> Attributes
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) (String, String) -> Attributes -> Attributes
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
"*")   (String, String) -> Attributes -> Attributes
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
"+")   (String, String) -> Attributes -> Attributes
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
"?")   (String, String) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) (Schema -> Schema
scWrap Schema
sc)
scCont Attributes
al (ElemRef String
n)           = [DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
NAME ((String
a_name, String
n) (String, String) -> Attributes -> Attributes
forall a. a -> [a] -> [a]
: Attributes
al) []]
scCont Attributes
_  (CharData DataTypeDescr
_)          = [DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
NAME [(String
a_name, String
"#PCDATA")] []]
scCont Attributes
_  Schema
_sc                   = [DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
NAME [(String
a_name, String
"bad-content-spec")] []]         -- error case

scConts                         :: Attributes -> Schemas -> XmlTrees
scConts :: Attributes -> Schemas -> XmlTrees
scConts Attributes
al Schemas
scs                  = [DTDElem -> Attributes -> XmlTrees -> XmlTree
XN.mkDTDElem DTDElem
CONTENT Attributes
al ((Schema -> XmlTrees) -> Schemas -> XmlTrees
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)
                                    ]
                                  , (String -> XmlTree) -> [String] -> XmlTrees
forall a b. (a -> b) -> [a] -> [b]
map (\ String
n -> DTDElem -> Attributes -> XmlTrees -> XmlTree
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                = (String -> String -> Attributes -> Attributes
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               = (String -> String -> Attributes -> Attributes
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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Schema -> String
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 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
scNmtoken       = String
k_nmtoken
        | Bool
otherwise             = String
k_cdata
    enums :: [String]
enums                       = String -> [String]
words (String -> [String]) -> (Schema -> String) -> Schema -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Schema -> String
xsdParam String
xsd_enumeration (Schema -> [String]) -> Schema -> [String]
forall a b. (a -> b) -> a -> b
$ Schema
sc

checkErr                        :: Bool -> String -> XmlTrees
checkErr :: Bool -> String -> XmlTrees
checkErr Bool
True String
s                 = [Int -> String -> XmlTree
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

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

-- | convert a pickler schema into a DTD descr

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 = (Schema -> Schema) -> Schemas -> Schemas
forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
remAttrDec Schemas
es
    as :: [(String, Schemas)]
as  = ((String, Schemas) -> Bool)
-> [(String, Schemas)] -> [(String, Schemas)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool)
-> ((String, Schemas) -> Bool) -> (String, Schemas) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schemas -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Schemas -> Bool)
-> ((String, Schemas) -> Schemas) -> (String, Schemas) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Schemas) -> Schemas
forall a b. (a, b) -> b
snd) ([(String, Schemas)] -> [(String, Schemas)])
-> (Schemas -> [(String, Schemas)])
-> Schemas
-> [(String, Schemas)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> [(String, Schemas)]) -> Schemas -> [(String, Schemas)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Schema -> [(String, Schemas)]
attrDec (Schemas -> [(String, Schemas)]) -> Schemas -> [(String, Schemas)]
forall a b. (a -> b) -> a -> b
$ Schemas
es
    rt :: String
rt  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Schema -> Maybe String) -> Schema -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Maybe String
elemName (Schema -> String) -> Schema -> String
forall a b. (a -> b) -> a -> b
$ Schema
sc

elementDeclarations     :: Schema -> Schemas
elementDeclarations :: Schema -> Schemas
elementDeclarations Schema
sc  = Schemas -> Schemas
elemRefs (Schemas -> Schemas) -> (Schemas -> Schemas) -> Schemas -> Schemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schemas -> Schemas -> Schemas
elementDecs [] (Schemas -> Schemas) -> Schemas -> Schemas
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 String -> [String] -> Bool
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
eSchema -> Schemas -> Schemas
forall a. a -> [a] -> [a]
:Schemas
es) [Schema
sc]
    elemDecs Schema
_                  = Schemas
es

elemNames               :: Schemas -> [Name]
elemNames :: Schemas -> [String]
elemNames               = (Schema -> [String]) -> Schemas -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String])
-> (Schema -> Maybe String) -> Schema -> [String]
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
_)  = String -> Maybe String
forall a. a -> Maybe a
Just String
n
elemName Schema
_              = Maybe String
forall a. Maybe a
Nothing

elemRefs        :: Schemas -> Schemas
elemRefs :: Schemas -> Schemas
elemRefs        = (Schema -> Schema) -> Schemas -> Schemas
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 ((Schema -> Schema) -> Schemas -> Schemas
forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
pruneElem Schemas
scs)
    pruneElem (Alt Schemas
scs)      = Schemas -> Schema
Alt ((Schema -> Schema) -> Schemas -> Schemas
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)                = (Schema -> Schemas) -> Schemas -> Schemas
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 (Schemas -> Schema) -> (Schemas -> Schemas) -> Schemas -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Schema) -> Schemas -> Schemas
forall a b. (a -> b) -> [a] -> [b]
map Schema -> Schema
remA (Schemas -> Schema) -> Schemas -> Schema
forall a b. (a -> b) -> a -> b
$ Schemas
scs
      remA Schema
sc1             = Schema
sc1
remAttrDec Schema
_
    = String -> Schema
forall a. HasCallStack => String -> a
error String
"illegal case in remAttrDec"

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