    {-# LANGUAGE CPP #-}
    -- | Pretty-print the internal Haskell model of XSD datatypes to a real
    --   Haskell module containing type declarations, and instances for parsing
    --   (and printing - though not yet implemented) values of those datatypes
    --   from(/to) XML.
    module Text.XML.HaXml.Schema.PrettyHaskell
      ( ppComment
      , ppModule
      , ppHighLevelDecl
      , ppHighLevelDecls
      , ppvList
      ) where

    #if MIN_VERSION_base(4,11,0)
    import Prelude hiding ((<>))
    #endif

    import Text.XML.HaXml.Types (QName(..),Namespace(..))
    import Text.XML.HaXml.Schema.HaskellTypeModel
    import Text.XML.HaXml.Schema.XSDTypeModel (Occurs(..))
    import Text.XML.HaXml.Schema.NameConversion
    import Text.PrettyPrint.HughesPJ as PP

    import Data.List (intersperse,notElem,inits)
    import Data.Maybe (isJust,fromJust,fromMaybe,catMaybes)
    import Data.Char (toLower)

    -- | Vertically pretty-print a list of things, with open and close brackets,
    --   and separators.
    ppvList :: String -> String -> String -> (a->Doc) -> [a] -> Doc
    ppvList :: forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    open String
    sep String
    close a -> Doc
    pp []     = String -> Doc
    text String
    open Doc -> Doc -> Doc
    <> String -> Doc
    text String
    close
    ppvList String
    open String
    sep String
    close a -> Doc
    pp (a
    x:[a]
    xs) = String -> Doc
    text String
    open Doc -> Doc -> Doc
    <+> a -> Doc
    pp a
    x
                                       Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    y-> String -> Doc
    text String
    sep Doc -> Doc -> Doc
    <+> a -> Doc
    pp a
    y) [a]
    xs)
                                       Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    close

    data CommentPosition = Before | After

    -- | Generate aligned haddock-style documentation.
    --   (but without escapes in comment text yet)
    ppComment :: CommentPosition -> Comment -> Doc
    ppComment :: CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    _   Comment
    Nothing  = Doc
    empty
    ppComment CommentPosition
    pos (Just String
    s) = case [String]
    ps of
      (String
    c:[String]
    cs) ->
          String -> Doc
    text String
    "--" Doc -> Doc -> Doc
    <+> String -> Doc
    text (case CommentPosition
    pos of CommentPosition
    Before -> String
    "|"; CommentPosition
    After -> String
    "^") Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    c
          Doc -> Doc -> Doc
    $$
          [Doc] -> Doc
    vcat ((String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x-> String -> Doc
    text String
    "--  " Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    x) [String]
    cs)
      [] -> Doc
    empty
      where
        ps :: [String]
    ps = String -> [String]
    lines (Int -> String -> String
    paragraph Int
    60 String
    s)

    -- | Generate aligned haddock-style docs for choices (where each choice
    --   has its own documentation, but haddock cannot place it directly next
    --   to the appropriate component.
    ppCommentForChoice :: CommentPosition -> Comment -> [[Element]] -> Doc
    ppCommentForChoice :: CommentPosition -> Comment -> [[Element]] -> Doc
    ppCommentForChoice CommentPosition
    pos Comment
    outer [[Element]]
    nested =
        String -> Doc
    text String
    "--" Doc -> Doc -> Doc
    <+> String -> Doc
    text (case CommentPosition
    pos of CommentPosition
    Before -> String
    "|"; CommentPosition
    After -> String
    "^") Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    c
        Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x-> String -> Doc
    text String
    "--  " Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    x) [String]
    cs)
        Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((String -> Doc) -> [String] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x-> String -> Doc
    text String
    "--  " Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    x) [String]
    bullets)
      where
        (String
    c:[String]
    cs)  = String -> [String]
    lines String
    intro
        intro :: String
    intro   = String -> (String -> String) -> Comment -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "Choice between:"
                        (\String
    s-> Int -> String -> String
    paragraph Int
    60 String
    sString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\n\nChoice between:")
                        Comment
    outer
        bullets :: [String]
    bullets = (String -> [String]) -> [String] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [String]
    lines
                  ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> [String] -> String)
    -> [Integer] -> [[String]] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Integer
    n [String]
    seq-> case [String]
    seq of
                                  [String
    x]-> String
    "\n("String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Integer -> String
    forall a. Show a => a -> String
    show Integer
    nString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ") "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String -> String
    paragraph Int
    56 String
    x
                                  [String]
    _  -> String
    "\n("String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Integer -> String
    forall a. Show a => a -> String
    show Integer
    nString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ") Sequence of:"
                                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\String
    s->String
    "\n\n  * "
                                                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String -> String
    paragraph Int
    52 String
    s)
                                                     [String]
    seq)
                            [Integer
    1..]
                  ([[String]] -> [String]) -> [[String]] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ([Element] -> [String]) -> [[Element]] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Element -> String) -> [Element] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> String
    safeComment) [[Element]]
    nested
        safeComment :: Element -> String
    safeComment Element
    Text = String
    "mixed text"
        safeComment e :: Element
    e@Element{} = String -> Comment -> String
    forall a. a -> Maybe a -> a
    fromMaybe (XName -> String
    xname (XName -> String) -> XName -> String
    forall a b. (a -> b) -> a -> b
    $ Element -> XName
    elem_name Element
    e) (Element -> Comment
    elem_comment Element
    e)
        safeComment Element
    e           = String -> Comment -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "unknown" (Element -> Comment
    elem_comment Element
    e)
        xname :: XName -> String
    xname (XName (N String
    x))     = String
    x
        xname (XName (QN Namespace
    ns String
    x)) = Namespace -> String
    nsPrefix Namespace
    nsString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ":"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    x

    -- | Pretty-print a Haskell-style name.
    ppHName :: HName -> Doc
    ppHName :: HName -> Doc
    ppHName (HName String
    x) = String -> Doc
    text String
    x

    -- | Pretty-print an XML-style name.
    ppXName :: XName -> Doc
    ppXName :: XName -> Doc
    ppXName (XName (N String
    x))     = String -> Doc
    text String
    x
    ppXName (XName (QN Namespace
    ns String
    x)) = String -> Doc
    text (Namespace -> String
    nsPrefix Namespace
    ns) Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ":" Doc -> Doc -> Doc
    <> String -> Doc
    text String
    x

    -- | Some different ways of using a Haskell identifier.
    ppModId, ppConId, ppVarId, ppUnqConId, ppUnqVarId, ppFwdConId
        :: NameConverter -> XName -> Doc
    ppModId :: NameConverter -> XName -> Doc
    ppModId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    modid NameConverter
    nx
    ppConId :: NameConverter -> XName -> Doc
    ppConId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    conid NameConverter
    nx
    ppVarId :: NameConverter -> XName -> Doc
    ppVarId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    varid NameConverter
    nx
    ppUnqConId :: NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    unqconid NameConverter
    nx
    ppUnqVarId :: NameConverter -> XName -> Doc
    ppUnqVarId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    unqvarid NameConverter
    nx
    ppFwdConId :: NameConverter -> XName -> Doc
    ppFwdConId NameConverter
    nx = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> HName
    fwdconid NameConverter
    nx

    ppJoinConId, ppFieldId :: NameConverter -> XName -> XName -> Doc
    ppJoinConId :: NameConverter -> XName -> XName -> Doc
    ppJoinConId NameConverter
    nx XName
    p XName
    q = HName -> Doc
    ppHName (NameConverter -> XName -> HName
    conid NameConverter
    nx XName
    p) Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "_" Doc -> Doc -> Doc
    <> HName -> Doc
    ppHName (NameConverter -> XName -> HName
    conid NameConverter
    nx XName
    q)
    ppFieldId :: NameConverter -> XName -> XName -> Doc
    ppFieldId   NameConverter
    nx XName
    t   = HName -> Doc
    ppHName (HName -> Doc) -> (XName -> HName) -> XName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameConverter -> XName -> XName -> HName
    fieldid NameConverter
    nx XName
    t

    -- | Convert a whole document from HaskellTypeModel to Haskell source text.
    ppModule :: NameConverter -> Module -> Doc
    ppModule :: NameConverter -> Module -> Doc
    ppModule NameConverter
    nx Module
    m =
        String -> Doc
    text String
    "{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "module" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx (Module -> XName
    module_name Module
    m)
        Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    2 (String -> Doc
    text String
    "( module" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx (Module -> XName
    module_name Module
    m)
                  Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((Decl -> Doc) -> [Decl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(XSDInclude XName
    ex Comment
    com)->
                                   CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    com
                                   Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    ", module" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    ex)
                               (Module -> [Decl]
    module_re_exports Module
    m))
                  Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    ") where")
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    " "
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "import Text.XML.HaXml.Schema.Schema (SchemaType(..),SimpleType(..),Extension(..),Restricts(..))"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "import Text.XML.HaXml.Schema.Schema as Schema"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "import Text.XML.HaXml.OneOfN"
        Doc -> Doc -> Doc
    $$ (case Module -> Maybe XName
    module_xsd_ns Module
    m of
             Maybe XName
    Nothing -> String -> Doc
    text String
    "import Text.XML.HaXml.Schema.PrimitiveTypes as Xsd"
             Just XName
    ns -> String -> Doc
    text String
    "import qualified Text.XML.HaXml.Schema.PrimitiveTypes as"Doc -> Doc -> Doc
    <+>NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    ns)
        Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((Decl -> Doc) -> [Decl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NameConverter -> Decl -> Doc
    ppHighLevelDecl NameConverter
    nx)
                     (Module -> [Decl]
    module_re_exports Module
    m [Decl] -> [Decl] -> [Decl]
    forall a. [a] -> [a] -> [a]
    ++ Module -> [Decl]
    module_import_only Module
    m))
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    " "
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- Some hs-boot imports are required, for fwd-declaring types."
        Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Maybe XName) -> Doc
    ppFwdDecl ([(XName, Maybe XName)] -> [Doc])
    -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (Decl -> [(XName, Maybe XName)])
    -> [Decl] -> [(XName, Maybe XName)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Decl -> [(XName, Maybe XName)]
    imports ([Decl] -> [(XName, Maybe XName)])
    -> [Decl] -> [(XName, Maybe XName)]
    forall a b. (a -> b) -> a -> b
    $ Module -> [Decl]
    module_decls Module
    m)
        Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Maybe XName) -> Doc
    ppFwdElem ([(XName, Maybe XName)] -> [Doc])
    -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ (Decl -> [(XName, Maybe XName)])
    -> [Decl] -> [(XName, Maybe XName)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Decl -> [(XName, Maybe XName)]
    importElems ([Decl] -> [(XName, Maybe XName)])
    -> [Decl] -> [(XName, Maybe XName)]
    forall a b. (a -> b) -> a -> b
    $ Module -> [Decl]
    module_decls Module
    m)
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    " "
        Doc -> Doc -> Doc
    $$ NameConverter -> [Decl] -> Doc
    ppHighLevelDecls NameConverter
    nx (Module -> [Decl]
    module_decls Module
    m)

      where
        imports :: Decl -> [(XName, Maybe XName)]
    imports (ElementsAttrsAbstract XName
    _ [(XName, Maybe XName)]
    deps Comment
    _) = [(XName, Maybe XName)]
    deps
        imports (ExtendComplexTypeAbstract XName
    _ XName
    _ [(XName, Maybe XName)]
    deps Maybe XName
    _ [XName]
    _ Comment
    _) = [(XName, Maybe XName)]
    deps
        imports Decl
    _ = []

        importElems :: Decl -> [(XName, Maybe XName)]
    importElems (ElementAbstractOfType XName
    _ XName
    _ [(XName, Maybe XName)]
    deps Comment
    _) = [(XName, Maybe XName)]
    deps
        importElems Decl
    _ = []

        ppFwdDecl :: (XName, Maybe XName) -> Doc
    ppFwdDecl (XName
    _,   Maybe XName
    Nothing)  = Doc
    empty
        ppFwdDecl (XName
    name,Just XName
    mod) = String -> Doc
    text String
    "import {-# SOURCE #-}" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    mod
                                    Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "(" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    name Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    ")"

        ppFwdElem :: (XName, Maybe XName) -> Doc
    ppFwdElem (XName
    _,   Maybe XName
    Nothing)  = Doc
    empty
        ppFwdElem (XName
    name,Just XName
    mod) = String -> Doc
    text String
    "import {-# SOURCE #-}" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    mod
                                    Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "("
                                        Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    name)
                                        Doc -> Doc -> Doc
    <> (String -> Doc
    text String
    ", elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    name)
                                    Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    ")"

    -- | Generate a fragmentary parser for an attribute.
    ppAttr :: Attribute -> Int -> Doc
    ppAttr :: Attribute -> Int -> Doc
    ppAttr Attribute
    a Int
    n = (String -> Doc
    text String
    "a"Doc -> Doc -> Doc
    <>String -> Doc
    text (Int -> String
    forall a. Show a => a -> String
    show Int
    n)) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "<-"
                                           Doc -> Doc -> Doc
    <+> (if Attribute -> Bool
    attr_required Attribute
    a then Doc
    empty
                                                     else String -> Doc
    text String
    "optional $")
                                           Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "getAttribute \""
                                           Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Attribute -> XName
    attr_name Attribute
    a)
                                           Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\" e pos"

    -- | Generate a fragmentary toXML for an attribute.
    toXmlAttr :: Attribute -> Doc
    toXmlAttr :: Attribute -> Doc
    toXmlAttr Attribute
    a = (if Attribute -> Bool
    attr_required Attribute
    a then Doc -> Doc
    forall a. a -> a
    id
                                      else (\Doc
    d-> String -> Doc
    text String
    "maybe []" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    d))
                  (String -> Doc
    text String
    "toXMLAttribute \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Attribute -> XName
    attr_name Attribute
    a) Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")

    -- | Generate a fragmentary parser for an element.
    ppElem :: NameConverter -> Element -> Doc
    ppElem :: NameConverter -> Element -> Doc
    ppElem NameConverter
    nx e :: Element
    e@Element{}
        | Element -> Bool
    elem_byRef Element
    e    = Modifier -> Doc -> Doc
    ppElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                                           (String -> Doc
    text String
    "element"
                                            Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e))
        | Bool
    otherwise       = Modifier -> Doc -> Doc
    ppElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                                           (String -> Doc
    text String
    "parseSchemaType \""
                                            Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Element -> XName
    elem_name Element
    e)
                                            Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")
    ppElem NameConverter
    nx e :: Element
    e@AnyElem{} = Modifier -> Doc -> Doc
    ppElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                              (String -> Doc
    text String
    "parseAnyElement")
    ppElem NameConverter
    nx e :: Element
    e@Text{}    = String -> Doc
    text String
    "parseText"
    ppElem NameConverter
    nx e :: Element
    e@OneOf{}   = Modifier -> Doc -> Doc
    ppElemModifier (Element -> Modifier
    liftedElemModifier Element
    e)
                              (String -> Doc
    text String
    "oneOf'" Doc -> Doc -> Doc
    <+> String
    -> String
    -> String
    -> (([Element], Int) -> Doc)
    -> [([Element], Int)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "[" String
    "," String
    "]"
                                                        (Int -> ([Element], Int) -> Doc
    forall {a}. Show a => a -> ([Element], Int) -> Doc
    ppOneOf Int
    n)
                                                        ([[Element]] -> [Int] -> [([Element], Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Element -> [[Element]]
    elem_oneOf Element
    e) [Int
    1..Int
    n]))
      where
        n :: Int
    n = [[Element]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Element -> [[Element]]
    elem_oneOf Element
    e)
        ppOneOf :: a -> ([Element], Int) -> Doc
    ppOneOf a
    n ([Element]
    e,Int
    i) = String -> Doc
    text String
    "(\"" Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hsep ((Element -> Doc) -> [Element] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    forall a. a -> a
    id)
                                             ([Element] -> [Doc])
    -> ([Element] -> [Element]) -> [Element] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Element] -> [Element]
    cleanChoices ([Element] -> [Doc]) -> [Element] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [Element]
    e)
                          Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\","
                          Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "fmap" Doc -> Doc -> Doc
    <+> String -> Doc
    text (Int -> String
    ordinal Int
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "Of"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++a -> String
    forall a. Show a => a -> String
    show a
    n)
                              Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens ([Element] -> Doc
    ppSeqElem ([Element] -> Doc) -> ([Element] -> [Element]) -> [Element] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Element] -> [Element]
    cleanChoices ([Element] -> Doc) -> [Element] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Element]
    e)
                          Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ")"
        ordinal :: Int -> String
    ordinal Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    20   = [String]
    ordinals[String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !!Int
    i
                  | Bool
    otherwise = String
    "Choice" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i
        ordinals :: [String]
    ordinals = [String
    "Zero",String
    "One",String
    "Two",String
    "Three",String
    "Four",String
    "Five",String
    "Six",String
    "Seven",String
    "Eight"
                   ,String
    "Nine",String
    "Ten",String
    "Eleven",String
    "Twelve",String
    "Thirteen",String
    "Fourteen",String
    "Fifteen"
                   ,String
    "Sixteen",String
    "Seventeen",String
    "Eighteen",String
    "Nineteen",String
    "Twenty"]
        ppSeqElem :: [Element] -> Doc
    ppSeqElem []  = Doc
    PP.empty
        ppSeqElem [Element
    e] = NameConverter -> Element -> Doc
    ppElem NameConverter
    nx Element
    e
        ppSeqElem [Element]
    es  = String -> Doc
    text (String
    "return ("String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    esInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ','String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ")")
                        Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    vcat ((Element -> Doc) -> [Element] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Element
    e-> String -> Doc
    text String
    "`apply`" Doc -> Doc -> Doc
    <+> NameConverter -> Element -> Doc
    ppElem NameConverter
    nx Element
    e) [Element]
    es)

    -- | Generate a fragmentary toXML for an element.  Fragment must still be
    --   applied to an actual element value.
    toXmlElem :: NameConverter -> Element -> Doc
    toXmlElem :: NameConverter -> Element -> Doc
    toXmlElem NameConverter
    nx e :: Element
    e@Element{}
        | Element -> Bool
    elem_byRef Element
    e    = Modifier -> Doc -> Doc
    xmlElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                                            (String -> Doc
    text String
    "elementToXML"
                                            Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e))
        | Bool
    otherwise       = Modifier -> Doc -> Doc
    xmlElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                                            (String -> Doc
    text String
    "schemaTypeToXML \""
                                            Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Element -> XName
    elem_name Element
    e)
                                            Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")
    toXmlElem NameConverter
    nx e :: Element
    e@AnyElem{} = Modifier -> Doc -> Doc
    xmlElemModifier (Element -> Modifier
    elem_modifier Element
    e)
                                               (String -> Doc
    text String
    "toXMLAnyElement")
    toXmlElem NameConverter
    nx e :: Element
    e@Text{}    = String -> Doc
    text String
    "toXMLText"
    toXmlElem NameConverter
    nx e :: Element
    e@OneOf{}   = Modifier -> Doc -> Doc
    xmlElemModifier (Element -> Modifier
    liftedElemModifier Element
    e)
                               (String -> Doc
    text String
    "foldOneOf" Doc -> Doc -> Doc
    <> String -> Doc
    text (Int -> String
    forall a. Show a => a -> String
    show Int
    n)
                               Doc -> Doc -> Doc
    <+> String
    -> String -> String -> ([Element] -> Doc) -> [[Element]] -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "" String
    "" String
    "" [Element] -> Doc
    xmlOneOf (Element -> [[Element]]
    elem_oneOf Element
    e))
      where
        n :: Int
    n = [[Element]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Element -> [[Element]]
    elem_oneOf Element
    e)
        xmlOneOf :: [Element] -> Doc
    xmlOneOf [Element]
    e = Doc -> Doc
    parens ([Element] -> Doc
    xmlSeqElem ([Element] -> Doc) -> ([Element] -> [Element]) -> [Element] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Element] -> [Element]
    cleanChoices ([Element] -> Doc) -> [Element] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Element]
    e)
        xmlSeqElem :: [Element] -> Doc
    xmlSeqElem []  = Doc
    PP.empty
        xmlSeqElem [Element
    e] = NameConverter -> Element -> Doc
    toXmlElem NameConverter
    nx Element
    e
        xmlSeqElem [Element]
    es  = String -> Doc
    text String
    "\\ (" Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    ",") [Doc]
    vars)
                         Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ") -> concat"
                         Doc -> Doc -> Doc
    <+> String
    -> String
    -> String
    -> ((Element, Doc) -> Doc)
    -> [(Element, Doc)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "[" String
    "," String
    "]" (\(Element
    e,Doc
    v)-> NameConverter -> Element -> Doc
    toXmlElem NameConverter
    nx Element
    e Doc -> Doc -> Doc
    <+> Doc
    v)
                                                 ([Element] -> [Doc] -> [(Element, Doc)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Element]
    es [Doc]
    vars)
            where vars :: [Doc]
    vars = (Char -> Doc) -> String -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Doc
    text(String -> Doc) -> (Char -> String) -> Char -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Char -> String -> String
    forall a. a -> [a] -> [a]
    :[])) (String -> [Doc]) -> (String -> String) -> String -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    take ([Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    es) (String -> [Doc]) -> String -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ [Char
    'a'..Char
    'z']

    -- | Convert multiple HaskellTypeModel Decls to Haskell source text.
    ppHighLevelDecls :: NameConverter -> [Decl] -> Doc
    ppHighLevelDecls :: NameConverter -> [Decl] -> Doc
    ppHighLevelDecls NameConverter
    nx [Decl]
    hs = [Doc] -> Doc
    vcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    " ")
                                               ((Decl -> Doc) -> [Decl] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NameConverter -> Decl -> Doc
    ppHighLevelDecl NameConverter
    nx) [Decl]
    hs))

    -- | Convert a single Haskell Decl into Haskell source text.
    ppHighLevelDecl :: NameConverter -> Decl -> Doc

    ppHighLevelDecl :: NameConverter -> Decl -> Doc
    ppHighLevelDecl NameConverter
    nx (NamedSimpleType XName
    t XName
    s Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "type" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- No instances required: synonym is isomorphic to the original."

    ppHighLevelDecl NameConverter
    nx (RestrictSimpleType XName
    t XName
    s [Restrict]
    r Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "newtype" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                          Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                          Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "deriving (Eq,Show)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance Restricts" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                          Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "restricts (" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x) = x")
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = do"
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "e <- element [s]"
                               Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "commit $ interior e $ parseSimpleType")
                      )
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s ("Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x) = "
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "toXMLElement s [] [toXMLText (simpleTypeText x)]")
                      )
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SimpleType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "acceptingParser = fmap" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                                                     Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "acceptingParser"
                       -- XXX should enforce the restrictions somehow.  (?)
                       Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- XXX should enforce the restrictions somehow?"
                       Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- The restrictions are:"
                       Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat ((Restrict -> Doc) -> [Restrict] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> Doc
    text String
    "--     " Doc -> Doc -> Doc
    <+>) (Doc -> Doc) -> (Restrict -> Doc) -> Restrict -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Restrict -> Doc
    ppRestrict) [Restrict]
    r))
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "simpleTypeText (" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                                              Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x) = simpleTypeText x")
      where
        ppRestrict :: Restrict -> Doc
    ppRestrict (RangeR Occurs
    occ Comment
    comm)     = String -> Doc
    text String
    "(RangeR"
                                             Doc -> Doc -> Doc
    <+> Occurs -> Doc
    ppOccurs Occurs
    occ Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    ")"
        ppRestrict (Pattern String
    regexp Comment
    comm) = String -> Doc
    text (String
    "(Pattern "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    regexpString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ")")
        ppRestrict (Enumeration [(String, Comment)]
    items)   = String -> Doc
    text String
    "(Enumeration"
                                             Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    hsep (((String, Comment) -> Doc) -> [(String, Comment)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Doc
    text (String -> Doc)
    -> ((String, Comment) -> String) -> (String, Comment) -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, Comment) -> String
    forall a b. (a, b) -> a
    fst) [(String, Comment)]
    items)
                                             Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    ")"
        ppRestrict (StrLength Occurs
    occ Comment
    comm)  = String -> Doc
    text String
    "(StrLength"
                                             Doc -> Doc -> Doc
    <+> Occurs -> Doc
    ppOccurs Occurs
    occ Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    ")"
        ppOccurs :: Occurs -> Doc
    ppOccurs = Doc -> Doc
    parens (Doc -> Doc) -> (Occurs -> Doc) -> Occurs -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc
    text (String -> Doc) -> (Occurs -> String) -> Occurs -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Occurs -> String
    forall a. Show a => a -> String
    show

    ppHighLevelDecl NameConverter
    nx (ExtendSimpleType XName
    t XName
    s [Attribute]
    as Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                                        Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                                        Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t_attrs
                                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "deriving (Eq,Show)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t_attrs Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t_attrs
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (NameConverter -> XName -> [Element] -> [Attribute] -> Doc
    ppFields NameConverter
    nx XName
    t_attrs [] [Attribute]
    as
                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "deriving (Eq,Show)")
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = do"
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "(pos,e) <- posnElement [s]"
                                Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "commit $ do"
                                Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    2
                                      ([Doc] -> Doc
    vcat ((Attribute -> Int -> Doc) -> [Attribute] -> [Int] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Attribute -> Int -> Doc
    ppAttr [Attribute]
    as [Int
    0..])
                                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "reparse [CElem e pos]"
                                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "v <- parseSchemaType s"
                                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "return $" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                                                         Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "v"
                                                         Doc -> Doc -> Doc
    <+> [Attribute] -> Doc
    forall {a}. [a] -> Doc
    attrsValue [Attribute]
    as)
                                )
                      )
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s ("Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                                                 Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "bt at) ="
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "addXMLAttributes"
                                 Doc -> Doc -> Doc
    <+> String
    -> String -> String -> (Attribute -> Doc) -> [Attribute] -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "[" String
    "," String
    "]"
                                         (\Attribute
    a-> Attribute -> Doc
    toXmlAttr Attribute
    a Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "$"
                                             Doc -> Doc -> Doc
    <+> NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t_attrs (Attribute -> XName
    attr_name Attribute
    a)
                                             Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "at")
                                         [Attribute]
    as
                                 Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "$ schemaTypeToXML s bt"))
                      )
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance Extension" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                                     Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "supertype (" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    " s _) = s")
      where
        t_attrs :: XName
    t_attrs = let (XName (N String
    t_base)) = XName
    t in QName -> XName
    XName (String -> QName
    N (String
    t_baseString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "Attributes"))

        attrsValue :: [a] -> Doc
    attrsValue [] = NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t_attrs
        attrsValue [a]
    as = Doc -> Doc
    parens (NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t_attrs Doc -> Doc -> Doc
    <+>
                                [Doc] -> Doc
    hsep [String -> Doc
    text (String
    "a"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    n) | Int
    n <- [Int
    0..[a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    asInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]])

        -- do element [s]
        --    blah <- attribute foo
        --    interior e $ do
        --        simple <- parseText acceptingParser
        --        return (T simple blah)

    ppHighLevelDecl NameConverter
    nx (UnionSimpleTypes XName
    t [XName]
    sts Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- Placeholder for a Union type, not yet implemented."

    ppHighLevelDecl NameConverter
    nx (EnumSimpleType XName
    t [] Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
    ppHighLevelDecl NameConverter
    nx (EnumSimpleType XName
    t [(XName, Comment)]
    is Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 ( String
    -> String
    -> String
    -> ((XName, Comment) -> Doc)
    -> [(XName, Comment)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "=" String
    "|" String
    "deriving (Eq,Show,Enum)" (XName, Comment) -> Doc
    item [(XName, Comment)]
    is )
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = do"
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "e <- element [s]"
                               Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "commit $ interior e $ parseSimpleType")
                      )
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s x = "
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "toXMLElement s [] [toXMLText (simpleTypeText x)]")
                      )
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SimpleType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "acceptingParser ="
                            Doc -> Doc -> Doc
    <+> String
    -> String
    -> String
    -> ((XName, Comment) -> Doc)
    -> [(XName, Comment)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "" String
    "`onFail`" String
    "" (XName, Comment) -> Doc
    forall {b}. (XName, b) -> Doc
    parseItem [(XName, Comment)]
    is
                       Doc -> Doc -> Doc
    $$ [Doc] -> Doc
    vcat (((XName, Comment) -> Doc) -> [(XName, Comment)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Comment) -> Doc
    forall {b}. (XName, b) -> Doc
    enumText [(XName, Comment)]
    is))
      where
        item :: (XName, Comment) -> Doc
    item (XName
    i,Comment
    c) = (NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "_" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    i)
                     Doc -> Doc -> Doc
    $$ CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After Comment
    c
        parseItem :: (XName, b) -> Doc
    parseItem (XName
    i,b
    _) = String -> Doc
    text String
    "do literal \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    i Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"; return"
                               Doc -> Doc -> Doc
    <+> (NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "_" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    i)
        enumText :: (XName, b) -> Doc
    enumText  (XName
    i,b
    _) = String -> Doc
    text String
    "simpleTypeText"
                               Doc -> Doc -> Doc
    <+> (NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "_" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    i)
                               Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "= \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    i Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\""

    ppHighLevelDecl NameConverter
    nx (ElementsAttrs XName
    t [Element]
    es [Attribute]
    as Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    8 (NameConverter -> XName -> [Element] -> [Attribute] -> Doc
    ppFields NameConverter
    nx XName
    t ([Element] -> [Element]
    uniqueify [Element]
    es) [Attribute]
    as
                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "deriving (Eq,Show)")
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = do"
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "(pos,e) <- posnElement [s]"
                           --   $$ text "commit $ do"
                           --   $$ nest 2
                                Doc -> Doc -> Doc
    $$    ([Doc] -> Doc
    vcat ((Attribute -> Int -> Doc) -> [Attribute] -> [Int] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Attribute -> Int -> Doc
    ppAttr [Attribute]
    as [Int
    0..])
                                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "commit $ interior e $ return"
                                          Doc -> Doc -> Doc
    <+> [Attribute] -> Doc
    forall {a}. [a] -> Doc
    returnValue [Attribute]
    as
                                          Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 ([Doc] -> Doc
    vcat ((Element -> Doc) -> [Element] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Doc
    ppApplyElem [Element]
    es))
                                      )
                                )
                      )
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s x@"Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "{} ="
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "toXMLElement s"
                                 Doc -> Doc -> Doc
    <+> String
    -> String -> String -> (Attribute -> Doc) -> [Attribute] -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "[" String
    "," String
    "]"
                                             (\Attribute
    a-> Attribute -> Doc
    toXmlAttr Attribute
    a Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "$"
                                                   Doc -> Doc -> Doc
    <+> NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (Attribute -> XName
    attr_name Attribute
    a)
                                                   Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x")
                                             [Attribute]
    as
                                 Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String
    -> String
    -> String
    -> ((Element, Int) -> Doc)
    -> [(Element, Int)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "[" String
    "," String
    "]"
                                               (\ (Element
    e,Int
    i)-> NameConverter -> Element -> Doc
    toXmlElem NameConverter
    nx Element
    e
                                                          Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "$"
                                                          Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t Element
    e Int
    i
                                                          Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x")
                                               ([Element] -> [Int] -> [(Element, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Element]
    es [Int
    0..]))
                                )
                      )
      where
        returnValue :: [a] -> Doc
    returnValue [] = NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
        returnValue [a]
    as = Doc -> Doc
    parens (NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+>
                                 [Doc] -> Doc
    hsep [String -> Doc
    text (String
    "a"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    n) | Int
    n <- [Int
    0..[a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    asInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1]])
        ppApplyElem :: Element -> Doc
    ppApplyElem Element
    e = String -> Doc
    text String
    "`apply`" Doc -> Doc -> Doc
    <+> NameConverter -> Element -> Doc
    ppElem NameConverter
    nx Element
    e

    ppHighLevelDecl NameConverter
    nx (ElementsAttrsAbstract XName
    t [] Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "--  (There are no subtypes defined for this abstract type.)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "=" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                       Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "deriving (Eq,Show)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = fail" Doc -> Doc -> Doc
    <+> Doc
    errmsg)
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s _ = toXMLElement s [] []")
      where
        errmsg :: Doc
    errmsg = String -> Doc
    text String
    "\"Parse failed when expecting an extension type of"
                 Doc -> Doc -> Doc
    <+> XName -> Doc
    ppXName XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ":\\n  No extension types are known.\""
    ppHighLevelDecl NameConverter
    nx (ElementsAttrsAbstract XName
    t [(XName, Maybe XName)]
    insts Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    8 (String
    -> String
    -> String
    -> ((XName, Maybe XName) -> Doc)
    -> [(XName, Maybe XName)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "=" String
    "|" String
    "" (XName, Maybe XName) -> Doc
    forall {a}. (XName, Maybe a) -> Doc
    ppAbstrCons [(XName, Maybe XName)]
    insts
                      Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "deriving (Eq,Show)")
    --  $$ text "-- instance SchemaType" <+> ppUnqConId nx t
    --      <+> text "(declared in Instance module)"
    --  *** Declare instance here
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType s = do"
                      Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 ([Doc] -> Doc
    vcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    "`onFail`")
                                                   (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Maybe XName) -> Doc
    forall {a}. (XName, Maybe a) -> Doc
    ppParse [(XName, Maybe XName)]
    insts)
                                       [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "`onFail` fail" Doc -> Doc -> Doc
    <+> Doc
    errmsg])))
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 ([Doc] -> Doc
    vcat (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Maybe XName) -> Doc
    forall {b}. (XName, b) -> Doc
    toXML [(XName, Maybe XName)]
    insts))
    --  $$ text ""
    --  $$ vcat (map ppFwdDecl $ filter (isJust . snd) insts)
      where
        ppAbstrCons :: (XName, Maybe a) -> Doc
    ppAbstrCons (XName
    name,Maybe a
    Nothing)  = XName -> Doc
    con XName
    name Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    name
        ppAbstrCons (XName
    name,Just a
    mod) = XName -> Doc
    con XName
    name Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    name
    --  *** Declare FwdDecl type here (proxy for type declared in later module)
    --  ppAbstrCons (name,Just mod) = text "forall q . (FwdDecl" <+>
    --                                fwd name <+> text "q," <+>
    --                                text "SchemaType q) =>" <+>
    --                                con name <+>
    --                                text "("<>fwd name<>text"->q)" <+> fwd name
        ppParse :: (XName, Maybe a) -> Doc
    ppParse (XName
    name,Maybe a
    Nothing) = String -> Doc
    text String
    "(fmap" Doc -> Doc -> Doc
    <+> XName -> Doc
    con XName
    name Doc -> Doc -> Doc
    <+>
                                 String -> Doc
    text String
    "$ parseSchemaType s)"
        ppParse (XName
    name,Just a
    _)  = (XName, Maybe a) -> Doc
    ppParse (XName
    name,Maybe a
    forall a. Maybe a
    Nothing)
    --  ppParse (name,Just _)  = text "(return" <+> con name <+>
    --                           text "`apply` (fmap const $ parseSchemaType s)" <+>
    --                           text "`apply` return" <+> fwd name <> text ")"
    --  ppFwdDecl (name,Just mod)
    --         = text "-- | Proxy:" <+> ppConId nx name
    --               <+> text "declared later in" <+> ppModId nx mod
    --           $$ text "data" <+> fwd name <+> text "=" <+> fwd name
        errmsg :: Doc
    errmsg = String -> Doc
    text String
    "\"Parse failed when expecting an extension type of"
                 Doc -> Doc -> Doc
    <+> XName -> Doc
    ppXName XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ",\\n\\\n\\  namely one of:\\n\\\n\\"
                 Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    ",")
                                      (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName -> Doc
    ppXName (XName -> Doc)
    -> ((XName, Maybe XName) -> XName) -> (XName, Maybe XName) -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XName, Maybe XName) -> XName
    forall a b. (a, b) -> a
    fst) [(XName, Maybe XName)]
    insts))
                 Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\""
    --  fwd name = ppFwdConId nx name
        con :: XName -> Doc
    con XName
    name = NameConverter -> XName -> XName -> Doc
    ppJoinConId NameConverter
    nx XName
    t XName
    name
        -- This is probably an unportable hack, but because an abstract type never
        -- has an element in its own name, we need to guess at the name of the
        -- possible subtype elements that could substitute for it.
        toXML :: (XName, b) -> Doc
    toXML (XName
    name,b
    _) = String -> Doc
    text String
    "schemaTypeToXML _s ("
                         Doc -> Doc -> Doc
    <> XName -> Doc
    con XName
    name Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x) = schemaTypeToXML \""
                         Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (XName -> XName
    initLower XName
    name) Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\" x"
        initLower :: XName -> XName
    initLower (XName (N (Char
    c:String
    cs))) = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N (Char -> Char
    toLower Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs)
        initLower (XName (QN Namespace
    ns (Char
    c:String
    cs))) = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ Namespace -> String -> QName
    QN Namespace
    ns (Char -> Char
    toLower Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs)

    ppHighLevelDecl NameConverter
    nx (ElementOfType e :: Element
    e@Element{}) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before (Element -> Comment
    elem_comment Element
    e)
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e)) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
            Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "XMLParser" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx (Element -> XName
    elem_type Element
    e)
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e)) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
            Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "parseSchemaType \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Element -> XName
    elem_name Element
    e)  Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e)) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
            Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx (Element -> XName
    elem_type Element
    e) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "-> [Content ()]"
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx (Element -> XName
    elem_name Element
    e)) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
            Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "schemaTypeToXML \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName (Element -> XName
    elem_name Element
    e)  Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")

    ppHighLevelDecl NameConverter
    nx e :: Decl
    e@(ElementAbstractOfType XName
    n XName
    t [] Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "--  (There are no elements in any substitution group for this element.)"
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
            Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "XMLParser" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
            Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "fail" Doc -> Doc -> Doc
    <+> Doc
    errmsg
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
            Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "-> [Content ()]"
        Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
            Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "schemaTypeToXML \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    n Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")
      where
        errmsg :: Doc
    errmsg = String -> Doc
    text String
    "\"Parse failed when expecting an element in the substitution group for\\n\\\n\\    <"
                 Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    n Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ">,\\n\\\n\\  There are no substitutable elements.\""
    ppHighLevelDecl NameConverter
    nx e :: Decl
    e@(ElementAbstractOfType XName
    n XName
    t [(XName, Maybe XName)]
    substgrp Comment
    comm)
    --  | any notInScope substgrp
    --              = (text "-- element" <> ppUnqConId nx n) <+> text "::"
    --                    <+> text "XMLParser" <+> ppConId nx t
    --              $$ text "--     declared in Instances module"
    {-  | otherwise-} = CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
                    Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "XMLParser" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t
                    Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                       Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    vcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    "`onFail`") (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName, Maybe XName) -> Doc
    forall {a}. (XName, Maybe a) -> Doc
    ppOne [(XName, Maybe XName)]
    substgrp)
                                 [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Doc
    text String
    "`onFail` fail" Doc -> Doc -> Doc
    <+> Doc
    errmsg])
                    Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
                        Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "-> [Content ()]"
                    Doc -> Doc -> Doc
    $$ (String -> Doc
    text String
    "elementToXML" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    n) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                        Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "schemaTypeToXML \"" Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    n Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "\"")
                --  $$ vcat (map elementToXML substgrp)
    --  | otherwise = ppElementAbstractOfType nx e
      where
        notInScope :: (a, Maybe a) -> Bool
    notInScope (a
    _,Just a
    _)  = Bool
    True
        notInScope (a
    _,Maybe a
    Nothing) = Bool
    False
        ppOne :: (XName, Maybe a) -> Doc
    ppOne (XName
    c,Maybe a
    Nothing) = String -> Doc
    text String
    "fmap" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "supertype" -- ppJoinConId nx t c
                            Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    c)
        ppOne (XName
    c,Just a
    _)  = String -> Doc
    text String
    "fmap" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "supertype" -- ppJoinConId nx t c
                            Doc -> Doc -> Doc
    <+> (String -> Doc
    text String
    "element" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    c)
                            Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "-- FIXME: element is forward-declared"
        errmsg :: Doc
    errmsg = String -> Doc
    text String
    "\"Parse failed when expecting an element in the substitution group for\\n\\\n\\    <"
                 Doc -> Doc -> Doc
    <> XName -> Doc
    ppXName XName
    n Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ">,\\n\\\n\\  namely one of:\\n\\\n\\<"
                 Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    ">, <")
                                      (((XName, Maybe XName) -> Doc) -> [(XName, Maybe XName)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName -> Doc
    ppXName (XName -> Doc)
    -> ((XName, Maybe XName) -> XName) -> (XName, Maybe XName) -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XName, Maybe XName) -> XName
    forall a b. (a, b) -> a
    fst) [(XName, Maybe XName)]
    substgrp))
                 Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ">\""
    --  elementToXML (c,_) = (text "elementToXML" <> ppUnqConId nx n)
    --                       <+> text "(" <> ppJoinConId nx t c
    --                       <+> text " x) = elementToXML" <> ppUnqConId nx c
    --                       <+> text "x"

    ppHighLevelDecl NameConverter
    nx (Choice XName
    t [Element]
    es Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "data" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
            Doc -> Doc -> Doc
    <+> Int -> Doc -> Doc
    nest Int
    4 ( String
    -> String
    -> String
    -> ((Element, Integer) -> Doc)
    -> [(Element, Integer)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "=" String
    "|" String
    "" (Element, Integer) -> Doc
    forall {a}. Show a => (Element, a) -> Doc
    choices ([Element] -> [Integer] -> [(Element, Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Element]
    es [Integer
    1..])
                       Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "deriving (Eq,Show)" )
      where
        choices :: (Element, a) -> Doc
    choices (Element
    e,a
    n) = (NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <> String -> Doc
    text (a -> String
    forall a. Show a => a -> String
    show a
    n))
                        Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx (Element -> XName
    elem_type Element
    e)

    -- Comment out the Group for now.  Groups get inlined into the ComplexType
    -- where they are used, so it may not be sensible to declare them separately
    -- as well.
    ppHighLevelDecl NameConverter
    nx (Group XName
    t [Element]
    es Comment
    comm) = Doc
    PP.empty
    --  ppComment Before comm
    --  $$ text "data" <+> ppConId nx t <+> text "="
    --                 <+> ppConId nx t <+> hsep (map (ppConId nx . elem_type) es)

    -- Possibly we want to declare a really more restrictive type, e.g.
    --    to remove optionality, (Maybe Foo) -> (Foo), [Foo] -> Foo
    --    consequently the "restricts" method should do a proper translation,
    --    not merely an unwrapping.
    ppHighLevelDecl NameConverter
    nx (RestrictComplexType XName
    t XName
    s Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "newtype" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                                           Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                                           Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "deriving (Eq,Show)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- plus different (more restrictive) parser"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "-- (parsing restrictions currently unimplemented)"
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance Restricts" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                                     Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "restricts (" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x) = x")
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "instance SchemaType" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "parseSchemaType = fmap " Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+>
                       String -> Doc
    text String
    ". parseSchemaType")
                    -- XXX should enforce the restriction.
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "schemaTypeToXML s (" Doc -> Doc -> Doc
    <> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "x)")
                       Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "= schemaTypeToXML s x"

    {-
    ppHighLevelDecl nx (ExtendComplexType t s es as _ comm)
        | length es + length as = 1 =
        ppComment Before comm
        $$ text "data" <+> ppConId nx t <+> text "="
                                        <+> ppConId nx t <+> ppConId nx s
                                        <+> ppFields nx t es as
                                        <+> text "deriving (Eq,Show)"
        $$ text "instance Extension" <+> ppConId nx t <+> ppConId nx s
                                     <+> ppAuxConId nx t <+> text "where"
            $$ nest 4 (text "supertype (" <> ppConId nx t <> text " s e) = s"
                       $$ text "extension (" <> ppConId nx t <> text " s e) = e")
    -}

    ppHighLevelDecl NameConverter
    nx (ExtendComplexType XName
    t XName
    s [Element]
    oes [Attribute]
    oas [Element]
    es [Attribute]
    as
                                          Maybe XName
    fwdReqd Bool
    absSup [XName]
    grandsuper Comment
    comm) =
        NameConverter -> Decl -> Doc
    ppHighLevelDecl NameConverter
    nx (XName -> [Element] -> [Attribute] -> Comment -> Decl
    ElementsAttrs XName
    t ([Element]
    oes[Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++[Element]
    es) ([Attribute]
    oas[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    as) Comment
    comm)
        Doc -> Doc -> Doc
    $$ NameConverter
    -> XName
    -> XName
    -> Maybe XName
    -> Bool
    -> [Element]
    -> [Attribute]
    -> [Element]
    -> [Attribute]
    -> Doc
    ppExtension NameConverter
    nx XName
    t XName
    s Maybe XName
    fwdReqd Bool
    absSup [Element]
    oes [Attribute]
    oas [Element]
    es [Attribute]
    as
        Doc -> Doc -> Doc
    $$ (if Bool -> Bool
    not ([XName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [XName]
    grandsuper) -- && not (isJust fwdReqd) -- && isJust fwdReqd
            then NameConverter -> XName -> [XName] -> (XName, Maybe XName) -> Doc
    ppSuperExtension NameConverter
    nx XName
    s [XName]
    grandsuper (XName
    t,Maybe XName
    forall a. Maybe a
    Nothing)
            else Doc
    empty)

    ppHighLevelDecl NameConverter
    nx (ExtendComplexTypeAbstract XName
    t XName
    s [(XName, Maybe XName)]
    insts
                                                  Maybe XName
    fwdReqd [XName]
    grandsuper Comment
    comm) =
        NameConverter -> Decl -> Doc
    ppHighLevelDecl NameConverter
    nx (XName -> [(XName, Maybe XName)] -> Comment -> Decl
    ElementsAttrsAbstract XName
    t [(XName, Maybe XName)]
    insts Comment
    comm)
        Doc -> Doc -> Doc
    $$ NameConverter
    -> XName
    -> XName
    -> Maybe XName
    -> Bool
    -> [Element]
    -> [Attribute]
    -> [Element]
    -> [Attribute]
    -> Doc
    ppExtension NameConverter
    nx XName
    t XName
    s Maybe XName
    fwdReqd Bool
    True [] [] [] []
    --  $$ if not (null grandsuper)
    --     then vcat (map (ppSuperExtension nx t grandsuper) insts)
    --                     -- FIXME some instances are missing!
    --     else empty

    ppHighLevelDecl NameConverter
    nx (XSDInclude XName
    m Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "import" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    m

    ppHighLevelDecl NameConverter
    nx (XSDImport XName
    m Maybe XName
    ma Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After Comment
    comm
        Doc -> Doc -> Doc
    $$ String -> Doc
    text String
    "import" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    m
                         Doc -> Doc -> Doc
    <+> Doc -> (XName -> Doc) -> Maybe XName -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty (\XName
    a->String -> Doc
    text String
    "as"Doc -> Doc -> Doc
    <+>NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    a) Maybe XName
    ma

    ppHighLevelDecl NameConverter
    nx (XSDComment Comment
    comm) =
        CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    Before Comment
    comm

    {-------------------------------------------------------------------------------

    -- | Instances that depend on FwdDecl'd types, need to be declared in a
    --   different module.  So they have been separated out from ppHighLevelDecl.
    ppHighLevelInstances :: NameConverter -> Decl -> Doc
    ppHighLevelInstances nx (ElementsAttrsAbstract t insts comm) =
        text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"
            $$ nest 4 (text "parseSchemaType s = do"
                      $$ nest 4 (vcat (intersperse (text "`onFail`")
                                                   (map ppParse insts)
                                       ++ [text "`onFail` fail" <+> errmsg])))
      where
        ppParse (name,Nothing) = text "(fmap" <+> con name <+>
                                 text "$ parseSchemaType s)"
        ppParse (name,Just _)  = text "(return" <+> con name <+>
                                 text "`apply` (fmap const $ parseSchemaType s)" <+>
                                 text "`apply` return" <+> fwd name <> text ")"
        errmsg = text "\"Parse failed when expecting an extension type of"
                 <+> ppXName t <> text ",\\n\\\n\\  namely one of:\\n\\\n\\"
                 <> hcat (intersperse (text ",")
                                      (map (ppXName . fst) insts))
                 <> text "\""
        fwd name = ppFwdConId nx name
        con name = ppJoinConId nx t name

    ppHighLevelInstances nx e@(ElementAbstractOfType n t substgrp comm)
        | any notInScope substgrp = ppElementAbstractOfType nx e
        | otherwise = empty
      where
        notInScope (_,Just _)  = True
        notInScope (_,Nothing) = False

    ppHighLevelInstances nx (ExtendComplexType t s oes oas es as
                                          fwdReqd absSup grandsuper comm) =
        empty
    --  ppExtension nx t s fwdReqd absSup oes oas es as
    --  $$ (if not (null grandsuper) && isJust fwdReqd
    --      then ppSuperExtension nx s grandsuper (t,Nothing)
    --      else empty)

    ppHighLevelInstances nx (ExtendComplexTypeAbstract t s insts
                                                       fwdReqd grandsuper comm) =
        ppHighLevelInstances nx (ElementsAttrsAbstract t insts comm)
    --  $$ ppExtension nx t s fwdReqd True [] [] [] []
    --  $$ if not (null grandsuper)
    --     then vcat (map (ppSuperExtension nx t grandsuper) insts)
    --                     -- FIXME some instances are missing!
    --     else empty

    ppElementAbstractOfType nx (ElementAbstractOfType n t substgrp comm) =
        ppComment Before comm
        $$ (text "element" <> ppUnqConId nx n) <+> text "::"
            <+> text "XMLParser" <+> ppConId nx t
        $$ (text "element" <> ppUnqConId nx n) <+> text "="
           <+> vcat (intersperse (text "`onFail`") (map ppOne substgrp)
                     ++ [text "`onFail` fail" <+> errmsg])
      where
        ppOne (c,Nothing) = text "fmap" <+> text "supertype" -- ppJoinConId nx t c
                            <+> (text "element" <> ppConId nx c)
        ppOne (c,Just _)  = text "fmap" <+> text "supertype" -- ppJoinConId nx t c
                            <+> (text "element" <> ppConId nx c)
                            <+> text "-- FIXME: element is forward-declared"
        errmsg = text "\"Parse failed when expecting an element in the substitution group for\\n\\\n\\    <"
                 <> ppXName n <> text ">,\\n\\\n\\  namely one of:\\n\\\n\\<"
                 <> hcat (intersperse (text ">, <")
                                      (map (ppXName . fst) substgrp))
                 <> text ">\""

    ----------------------------------------------------------------------------- -}

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

    -- | Generate an instance of the Extension class for a subtype/supertype pair.
    ppExtension :: NameConverter -> XName -> XName -> Maybe XName -> Bool ->
                   [Element] -> [Attribute] -> [Element] -> [Attribute] -> Doc
    ppExtension :: NameConverter
    -> XName
    -> XName
    -> Maybe XName
    -> Bool
    -> [Element]
    -> [Attribute]
    -> [Element]
    -> [Attribute]
    -> Doc
    ppExtension NameConverter
    nx XName
    t XName
    s Maybe XName
    fwdReqd Bool
    abstractSuper [Element]
    oes [Attribute]
    oas [Element]
    es [Attribute]
    as =
        String -> Doc
    text String
    "instance Extension" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    s
                                  Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
           Doc -> Doc -> Doc
    $$ (if Bool
    abstractSuper then
               Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "supertype v" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "="
                                          Doc -> Doc -> Doc
    <+> NameConverter -> XName -> XName -> Doc
    ppJoinConId NameConverter
    nx XName
    s XName
    t Doc -> Doc -> Doc
    <+>
                                     --   (if isJust fwdReqd
                                     --    then text "(\\_-> v)" <+> ppFwdConId nx t
                                     --    else text "v")
                                          String -> Doc
    text String
    "v")
               else
               Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "supertype (" Doc -> Doc -> Doc
    <> XName -> [Element] -> [Attribute] -> Doc
    forall {t :: * -> *} {t :: * -> *} {a} {a}.
    (Foldable t, Foldable t) =>
    XName -> t a -> t a -> Doc
    ppType XName
    t ([Element]
    oes[Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++[Element]
    es) ([Attribute]
    oas[Attribute] -> [Attribute] -> [Attribute]
    forall a. [a] -> [a] -> [a]
    ++[Attribute]
    as)
                                          Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ") ="
                                          Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    11 (XName -> [Element] -> [Attribute] -> Doc
    forall {t :: * -> *} {t :: * -> *} {a} {a}.
    (Foldable t, Foldable t) =>
    XName -> t a -> t a -> Doc
    ppType XName
    s [Element]
    oes [Attribute]
    oas) ))
    --  $$ (if isJust fwdReqd then
    --     -- text "data" <+> fwd t <+> text "=" <+> fwd t $$  -- already defined
    --        text ""
    --        $$ text "-- | Proxy" <+> fwd t <+> text "was declared earlier in"
    --                   <+> ppModId nx (fromJust fwdReqd)
    --        $$ text "instance FwdDecl" <+> fwd t <+> ppConId nx t
    --      else empty)
      where
        fwd :: XName -> Doc
    fwd XName
    name = NameConverter -> XName -> Doc
    ppFwdConId NameConverter
    nx XName
    name
        ppType :: XName -> t a -> t a -> Doc
    ppType XName
    t t a
    es t a
    as = NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
                         Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    hsep (Int -> [Doc] -> [Doc]
    forall a. Int -> [a] -> [a]
    take (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    as) [String -> Doc
    text (Char
    'a'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Integer -> String
    forall a. Show a => a -> String
    show Integer
    n) | Integer
    n<-[Integer
    0..]])
                         Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    hsep (Int -> [Doc] -> [Doc]
    forall a. Int -> [a] -> [a]
    take (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    es) [String -> Doc
    text (Char
    'e'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Integer -> String
    forall a. Show a => a -> String
    show Integer
    n) | Integer
    n<-[Integer
    0..]])

    -- | Generate an instance of the Extension class for a type and its
    --   "grand"-supertype, that is, the supertype of its supertype.
    ppSuperExtension :: NameConverter -> XName -> [XName]
                        -> (XName,Maybe XName) -> Doc
    {-
    ppSuperExtension nx super (grandSuper:_) (t,Nothing) =
        text "instance Extension" <+> ppUnqConId nx t <+> ppConId nx grandSuper
                                  <+> text "where"
        $$ nest 4 (text "supertype = (supertype ::"
                                               <+> ppUnqConId nx super
                                               <+> text "->"
                                               <+> ppConId nx grandSuper <> text ")"
                  $$ nest 12 (text ". (supertype ::"
                                               <+> ppUnqConId nx t
                                               <+> text "->"
                                               <+> ppConId nx super <> text ")"))
    -}
    ppSuperExtension :: NameConverter -> XName -> [XName] -> (XName, Maybe XName) -> Doc
    ppSuperExtension NameConverter
    nx XName
    super [XName]
    grandSupers (XName
    t,Just XName
    mod) =  -- fwddecl
        String -> Doc
    text String
    "-- Note that" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t
        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "will be declared later in module" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppModId NameConverter
    nx XName
    mod
        Doc -> Doc -> Doc
    $$ NameConverter -> XName -> [XName] -> (XName, Maybe XName) -> Doc
    ppSuperExtension NameConverter
    nx XName
    super [XName]
    grandSupers (XName
    t,Maybe XName
    forall a. Maybe a
    Nothing)
    ppSuperExtension NameConverter
    nx XName
    super [XName]
    grandSupers (XName
    t,Maybe XName
    Nothing) =
        [Doc] -> Doc
    vcat (([XName] -> Doc) -> [[XName]] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (XName -> [XName] -> Doc
    ppSuper XName
    t ([XName] -> Doc) -> ([XName] -> [XName]) -> [XName] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [XName] -> [XName]
    forall a. [a] -> [a]
    reverse) (Int -> [[XName]] -> [[XName]]
    forall a. Int -> [a] -> [a]
    drop Int
    2 ([[XName]] -> [[XName]])
    -> ([XName] -> [[XName]]) -> [XName] -> [[XName]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [XName] -> [[XName]]
    forall a. [a] -> [[a]]
    inits ([XName] -> [[XName]]) -> [XName] -> [[XName]]
    forall a b. (a -> b) -> a -> b
    $ XName
    superXName -> [XName] -> [XName]
    forall a. a -> [a] -> [a]
    : [XName]
    grandSupers))
      where
        ppSuper :: XName -> [XName] -> Doc
        ppSuper :: XName -> [XName] -> Doc
    ppSuper XName
    t gss :: [XName]
    gss@(XName
    gs:[XName]
    _) =
            String -> Doc
    text String
    "instance Extension" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    t Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    gs
                                      Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "where"
            Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest Int
    4 (String -> Doc
    text String
    "supertype" Doc -> Doc -> Doc
    <+>
                          String
    -> String
    -> String
    -> ((XName, XName) -> Doc)
    -> [(XName, XName)]
    -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "=" String
    "." String
    "" (XName, XName) -> Doc
    coerce ([XName] -> [XName] -> [(XName, XName)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([XName] -> [XName]
    forall a. HasCallStack => [a] -> [a]
    tail [XName]
    gss[XName] -> [XName] -> [XName]
    forall a. [a] -> [a] -> [a]
    ++[XName
    t]) [XName]
    gss))
        coerce :: (XName, XName) -> Doc
    coerce (XName
    a,XName
    b) = String -> Doc
    text String
    "(supertype ::" Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppUnqConId NameConverter
    nx XName
    a
                                            Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "->"
                                            Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx XName
    b Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ")"

    -- | Generate named fields from elements and attributes.
    ppFields :: NameConverter -> XName -> [Element] -> [Attribute] -> Doc
    ppFields :: NameConverter -> XName -> [Element] -> [Attribute] -> Doc
    ppFields NameConverter
    nx XName
    t [Element]
    es [Attribute]
    as | [Element] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Element]
    es Bool -> Bool -> Bool
    && [Attribute] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Attribute]
    as = Doc
    empty
    ppFields NameConverter
    nx XName
    t [Element]
    es [Attribute]
    as =  String -> String -> String -> (Doc -> Doc) -> [Doc] -> Doc
    forall a. String -> String -> String -> (a -> Doc) -> [a] -> Doc
    ppvList String
    "{" String
    "," String
    "}" Doc -> Doc
    forall a. a -> a
    id [Doc]
    fields
      where
        fields :: [Doc]
    fields = (Attribute -> Doc) -> [Attribute] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NameConverter -> XName -> Attribute -> Doc
    ppFieldAttribute NameConverter
    nx XName
    t) [Attribute]
    as [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++
                 (Element -> Int -> Doc) -> [Element] -> [Int] -> [Doc]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (NameConverter -> XName -> Element -> Int -> Doc
    ppFieldElement NameConverter
    nx XName
    t) [Element]
    es [Int
    0..]

    -- | Generate a single named field (including type sig) from an element.
    ppFieldElement :: NameConverter -> XName -> Element -> Int -> Doc
    ppFieldElement :: NameConverter -> XName -> Element -> Int -> Doc
    ppFieldElement NameConverter
    nx XName
    t e :: Element
    e@Element{} Int
    i = NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t Element
    e Int
    i
                                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    forall a. a -> a
    id Element
    e
                                        Doc -> Doc -> Doc
    $$ CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After (Element -> Comment
    elem_comment Element
    e)
    ppFieldElement NameConverter
    nx XName
    t e :: Element
    e@OneOf{}   Int
    i = NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t Element
    e Int
    i
                                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    forall a. a -> a
    id Element
    e
                                        Doc -> Doc -> Doc
    $$ CommentPosition -> Comment -> [[Element]] -> Doc
    ppCommentForChoice CommentPosition
    After (Element -> Comment
    elem_comment Element
    e)
                                                                    (Element -> [[Element]]
    elem_oneOf Element
    e)
    ppFieldElement NameConverter
    nx XName
    t e :: Element
    e@AnyElem{} Int
    i = NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t Element
    e Int
    i
                                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    forall a. a -> a
    id Element
    e
                                        Doc -> Doc -> Doc
    $$ CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After (Element -> Comment
    elem_comment Element
    e)
    ppFieldElement NameConverter
    nx XName
    t e :: Element
    e@Text{}    Int
    i = NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t Element
    e Int
    i
                                        Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    forall a. a -> a
    id Element
    e

    -- | Generate a single named field (no type sig) from an element.
    ppFieldName :: NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName :: NameConverter -> XName -> Element -> Int -> Doc
    ppFieldName NameConverter
    nx XName
    t e :: Element
    e@Element{} Int
    _ = NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (Element -> XName
    elem_name Element
    e)
    ppFieldName NameConverter
    nx XName
    t e :: Element
    e@OneOf{}   Int
    i = NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ String
    "choice"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    i)
    ppFieldName NameConverter
    nx XName
    t e :: Element
    e@AnyElem{} Int
    i = NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ String
    "any"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    i)
    ppFieldName NameConverter
    nx XName
    t e :: Element
    e@Text{}    Int
    i = NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ String
    "text"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    i)

    -- | What is the name of the type for an Element (or choice of Elements)?
    ppElemTypeName :: NameConverter -> (Doc->Doc) -> Element -> Doc
    ppElemTypeName :: NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    brack e :: Element
    e@Element{} =
        Modifier -> (Doc -> Doc) -> Doc -> Doc
    ppTypeModifier (Element -> Modifier
    elem_modifier Element
    e) Doc -> Doc
    brack (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ NameConverter -> XName -> Doc
    ppConId NameConverter
    nx (Element -> XName
    elem_type Element
    e)
    ppElemTypeName NameConverter
    nx Doc -> Doc
    brack e :: Element
    e@OneOf{}   =
        Doc -> Doc
    brack (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Modifier -> (Doc -> Doc) -> Doc -> Doc
    ppTypeModifier (Element -> Modifier
    liftedElemModifier Element
    e) Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
        String -> Doc
    text String
    "OneOf" Doc -> Doc -> Doc
    <> String -> Doc
    text (Int -> String
    forall a. Show a => a -> String
    show ([[Element]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Element -> [[Element]]
    elem_oneOf Element
    e)))
         Doc -> Doc -> Doc
    <+> [Doc] -> Doc
    hsep (([Element] -> Doc) -> [[Element]] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Element] -> Doc
    ppSeq ([Element] -> Doc) -> ([Element] -> [Element]) -> [Element] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Element] -> [Element]
    cleanChoices) (Element -> [[Element]]
    elem_oneOf Element
    e))
      where
        ppSeq :: [Element] -> Doc
    ppSeq []  = String -> Doc
    text String
    "()"
        ppSeq [Element
    e] = NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    parens Element
    e
        ppSeq [Element]
    es  = String -> Doc
    text String
    "(" Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hcat (Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse (String -> Doc
    text String
    ",")
                                         ((Element -> Doc) -> [Element] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (NameConverter -> (Doc -> Doc) -> Element -> Doc
    ppElemTypeName NameConverter
    nx Doc -> Doc
    parens) [Element]
    es))
                             Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ")"
    ppElemTypeName NameConverter
    nx Doc -> Doc
    brack e :: Element
    e@AnyElem{} =
        Doc -> Doc
    brack (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Modifier -> (Doc -> Doc) -> Doc -> Doc
    ppTypeModifier (Element -> Modifier
    elem_modifier Element
    e) Doc -> Doc
    forall a. a -> a
    id (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
        String -> Doc
    text String
    "AnyElement"
    ppElemTypeName NameConverter
    nx Doc -> Doc
    brack e :: Element
    e@Text{} =
        String -> Doc
    text String
    "String"

    -- | Generate a single named field from an attribute.
    ppFieldAttribute :: NameConverter -> XName -> Attribute -> Doc
    ppFieldAttribute :: NameConverter -> XName -> Attribute -> Doc
    ppFieldAttribute NameConverter
    nx XName
    t Attribute
    a = NameConverter -> XName -> XName -> Doc
    ppFieldId NameConverter
    nx XName
    t (Attribute -> XName
    attr_name Attribute
    a) Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::"
                                       Doc -> Doc -> Doc
    <+> (if Attribute -> Bool
    attr_required Attribute
    a then Doc
    empty
                                               else String -> Doc
    text String
    "Maybe")
                                       Doc -> Doc -> Doc
    <+> NameConverter -> XName -> Doc
    ppConId NameConverter
    nx (Attribute -> XName
    attr_type Attribute
    a)
                              Doc -> Doc -> Doc
    $$ CommentPosition -> Comment -> Doc
    ppComment CommentPosition
    After (Attribute -> Comment
    attr_comment Attribute
    a)

    -- | Generate a list or maybe type name (possibly parenthesised).
    ppTypeModifier :: Modifier -> (Doc->Doc) -> Doc -> Doc
    ppTypeModifier :: Modifier -> (Doc -> Doc) -> Doc -> Doc
    ppTypeModifier Modifier
    Single   Doc -> Doc
    _ Doc
    d  = Doc
    d
    ppTypeModifier Modifier
    Optional Doc -> Doc
    k Doc
    d  = Doc -> Doc
    k (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Doc
    text String
    "Maybe" Doc -> Doc -> Doc
    <+> Doc -> Doc
    k Doc
    d
    ppTypeModifier (Range (Occurs Maybe Int
    Nothing Maybe Int
    Nothing))  Doc -> Doc
    _ Doc
    d = Doc
    d
    ppTypeModifier (Range (Occurs (Just Int
    0) Maybe Int
    Nothing)) Doc -> Doc
    k Doc
    d = Doc -> Doc
    k (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Doc
    text String
    "Maybe" Doc -> Doc -> Doc
    <+> Doc -> Doc
    k Doc
    d
    ppTypeModifier (Range (Occurs Maybe Int
    _ Maybe Int
    _))              Doc -> Doc
    _ Doc
    d = String -> Doc
    text String
    "[" Doc -> Doc -> Doc
    <> Doc
    d Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "]"

    -- | Generate a parser for a list or Maybe value.
    ppElemModifier :: Modifier -> Doc -> Doc
    ppElemModifier :: Modifier -> Doc -> Doc
    ppElemModifier Modifier
    Single    Doc
    doc = Doc
    doc
    ppElemModifier Modifier
    Optional  Doc
    doc = String -> Doc
    text String
    "optional" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    ppElemModifier (Range (Occurs Maybe Int
    Nothing Maybe Int
    Nothing))  Doc
    doc = Doc
    doc
    ppElemModifier (Range (Occurs (Just Int
    0) Maybe Int
    Nothing)) Doc
    doc = String -> Doc
    text String
    "optional"
                                                           Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    ppElemModifier (Range (Occurs (Just Int
    0) (Just Int
    n))) Doc
    doc
                   | Int
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    forall a. Bounded a => a
    maxBound = String -> Doc
    text String
    "many" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    ppElemModifier (Range (Occurs Maybe Int
    Nothing  (Just Int
    n))) Doc
    doc
                   | Int
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    forall a. Bounded a => a
    maxBound = String -> Doc
    text String
    "many1" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    ppElemModifier (Range (Occurs (Just Int
    1) (Just Int
    n))) Doc
    doc
                   | Int
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    forall a. Bounded a => a
    maxBound = String -> Doc
    text String
    "many1" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    ppElemModifier (Range Occurs
    o) Doc
    doc = String -> Doc
    text String
    "between" Doc -> Doc -> Doc
    <+> (Doc -> Doc
    parens (String -> Doc
    text (Occurs -> String
    forall a. Show a => a -> String
    show Occurs
    o))
                                                      Doc -> Doc -> Doc
    $$ Doc -> Doc
    parens Doc
    doc)

    -- | Generate a toXML for a list or Maybe value.
    xmlElemModifier :: Modifier -> Doc -> Doc
    xmlElemModifier :: Modifier -> Doc -> Doc
    xmlElemModifier Modifier
    Single    Doc
    doc = Doc
    doc
    xmlElemModifier Modifier
    Optional  Doc
    doc = String -> Doc
    text String
    "maybe []" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    xmlElemModifier (Range (Occurs Maybe Int
    Nothing Maybe Int
    Nothing))  Doc
    doc = Doc
    doc
    xmlElemModifier (Range (Occurs (Just Int
    0) Maybe Int
    Nothing)) Doc
    doc = String -> Doc
    text String
    "maybe []"
                                                            Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc
    xmlElemModifier (Range (Occurs Maybe Int
    _ Maybe Int
    _)) Doc
    doc = String -> Doc
    text String
    "concatMap" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens Doc
    doc

    -- | Eliminate a Maybe type modifier, when it occurs directly inside a
    --   choice construct (since a parsed Nothing would always be preferred over
    --   a real value later in the choice).  Likewise, empty lists must
    --   be disallowed inside choice.
    cleanChoices :: [Element] -> [Element]
    cleanChoices :: [Element] -> [Element]
    cleanChoices [e :: Element
    e@Element{}] = (Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    :[]) (Element -> [Element]) -> Element -> [Element]
    forall a b. (a -> b) -> a -> b
    $
        case Element -> Modifier
    elem_modifier Element
    e of
          Range (Occurs (Just Int
    0) Maybe Int
    Nothing) -> Element
    e{elem_modifier=Single}
          Range (Occurs (Just Int
    0) Maybe Int
    max)-> Element
    e{elem_modifier=Range (Occurs (Just 1) max)}
          Modifier
    _ -> Element
    e
    cleanChoices [Element]
    es = [Element]
    es

    -- | Sometimes, a choice without a type modifier contains element sequences,
    --   all of which have the same modifier. In that case, it makes sense to lift
    --   the modifier (typically Maybe) to the outer layer.
    liftedElemModifier :: Element -> Modifier
    liftedElemModifier :: Element -> Modifier
    liftedElemModifier e :: Element
    e@OneOf{} =
        case Element -> Modifier
    elem_modifier Element
    e of
          Range (Occurs Maybe Int
    Nothing Maybe Int
    Nothing) -> Modifier
    newModifier
          Modifier
    Single -> Modifier
    newModifier
          Modifier
    m -> Modifier
    m
      where
        newModifier :: Modifier
    newModifier = if (Element -> Bool) -> [Element] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\Element
    x-> case Element
    x of
                                     Element
    Text -> Bool
    True
                                     Element
    _ -> case Element -> Modifier
    elem_modifier Element
    x of
                                            Range (Occurs (Just Int
    0) Maybe Int
    _) -> Bool
    True
                                            Modifier
    Optional                  -> Bool
    True
                                            Modifier
    _                         -> Bool
    False)
                             ([[Element]] -> [Element]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Element -> [[Element]]
    elem_oneOf Element
    e))
                      then Modifier
    Optional
                      else Modifier
    Single

    -- | Split long lines of comment text into a paragraph with a maximum width.
    paragraph :: Int -> String -> String
    paragraph :: Int -> String -> String
    paragraph Int
    n String
    s = Int -> [String] -> String
    go Int
    n (String -> [String]
    words String
    s)
        where go :: Int -> [String] -> String
    go Int
    i []     = []
              go Int
    i [String
    x]    | Int
    lenInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    i     =       String
    x
                          | Bool
    otherwise = String
    "\n"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    x
                  where len :: Int
    len = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    x
              go Int
    i (String
    x:[String]
    xs) | Int
    lenInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    i     =       String
    xString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> [String] -> String
    go (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [String]
    xs
                          | Bool
    otherwise = String
    "\n"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    xString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> [String] -> String
    go (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [String]
    xs
                  where len :: Int
    len = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    x

    uniqueify :: [Element] -> [Element]
    uniqueify :: [Element] -> [Element]
    uniqueify = [String] -> [Element] -> [Element]
    go []
      where
        go :: [String] -> [Element] -> [Element]
    go [String]
    seen [] = []
        go [String]
    seen (e :: Element
    e@Element{}:[Element]
    es)
            | XName -> String
    forall a. Show a => a -> String
    show (Element -> XName
    elem_name Element
    e) String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    seen
                        = let fresh :: XName
    fresh = (String -> Bool) -> XName -> XName
    new (String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`[String]
    seen) (Element -> XName
    elem_name Element
    e) in
                          Element
    e{elem_name=fresh} Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [String] -> [Element] -> [Element]
    go (XName -> String
    forall a. Show a => a -> String
    show XName
    freshString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    seen) [Element]
    es
            | Bool
    otherwise = Element
    eElement -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [String] -> [Element] -> [Element]
    go (XName -> String
    forall a. Show a => a -> String
    show (Element -> XName
    elem_name Element
    e)String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    seen) [Element]
    es
        go [String]
    seen (Element
    e:[Element]
    es)  = Element
    e Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [String] -> [Element] -> [Element]
    go [String]
    seen [Element]
    es
        new :: (String -> Bool) -> XName -> XName
    new String -> Bool
    pred (XName (N String
    n))     = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ String -> QName
    N (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. HasCallStack => [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                                     (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile String -> Bool
    pred [String
    nString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Integer -> String
    forall a. Show a => a -> String
    show Integer
    i | Integer
    i <- [Integer
    2..]]
        new String -> Bool
    pred (XName (QN Namespace
    ns String
    n)) = QName -> XName
    XName (QName -> XName) -> QName -> XName
    forall a b. (a -> b) -> a -> b
    $ Namespace -> String -> QName
    QN Namespace
    ns (String -> QName) -> String -> QName
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. HasCallStack => [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                                     (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile String -> Bool
    pred [String
    nString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Integer -> String
    forall a. Show a => a -> String
    show Integer
    i | Integer
    i <- [Integer
    2..]]