    {-# 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 a. [a] -> 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 -> NTree XNode
    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 a. [a] -> 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 -> NTree XNode
    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 -> NTree XNode
    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 a. [a] -> 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 -> NTree XNode
    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 -> 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")] []]         -- error case

    scConts                         :: Attributes -> Schemas -> XmlTrees
    scConts :: Attributes -> Schemas -> XmlTrees
    scConts Attributes
    al Schemas
    scs                  = [DTDElem -> Attributes -> XmlTrees -> NTree XNode
    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 -> NTree XNode) -> [String] -> XmlTrees
    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                = (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 -> NTree XNode
    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 a. [a] -> 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 a. Eq a => a -> [a] -> 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"

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