    {-# LANGUAGE FlexibleInstances #-}
    -- Copyright 2024 United States Government as represented by the Administrator
    -- of the National Aeronautics and Space Administration. All Rights Reserved.
    --
    -- Licensed under the Apache License, Version 2.0 (the "License"); you may
    -- not use this file except in compliance with the License. You may obtain a
    -- copy of the License at
    --
    --      https://www.apache.org/licenses/LICENSE-2.0
    --
    -- Unless required by applicable law or agreed to in writing, software
    -- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
    -- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
    -- License for the specific language governing permissions and limitations
    -- under the License.

    -- | Print XML trees.
    --
    -- This variant of the function to show XML trees available in HXT is needed
    -- because of issues with values being quoted by HXT's default function.
    --
    -- It's based on the same ideas, but it's been implemented using the
    -- pretty-library instead of using plain string functions.
    module Language.XMLSpec.PrintTrees where

    -- External imports
    import Data.Maybe                   (fromMaybe, isNothing)
    import Data.Tree.NTree.TypeDefs     (NTree (NTree))
    import Prelude                      hiding (quot, (<>))
    import Text.PrettyPrint.HughesPJ    (Doc, Mode (..), Style (..), brackets, char,
                                         colon, doubleQuotes, empty, equals, hcat,
                                         int, isEmpty, parens, renderStyle, space,
                                         text, vcat, (<+>), (<>))
    import Text.Regex.XMLSchema.Generic (sed)
    import Text.XML.HXT.Core            hiding (getDTDAttrl, getNode, mkDTDElem,
                                         xshow, (<+>), txt)
    import Text.XML.HXT.DOM.ShowXml     (xshow)
    import Text.XML.HXT.DOM.XmlNode     (getDTDAttrl, getNode, mkDTDElem)

    -- | Render a document into a string.
    flattenDoc :: Doc -> String
    flattenDoc :: Doc -> String
    flattenDoc = Style -> Doc -> String
    renderStyle (Mode -> Int -> Float -> Style
    Style Mode
    LeftMode Int
    0 Float
    0)

    -- | Class for values that can be converted into a document.
    class Pretty x where
      pretty :: x -> Doc

    instance Pretty [XmlTree] where
      pretty :: [NTree XNode] -> Doc
    pretty = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> ([NTree XNode] -> [Doc]) -> [NTree XNode] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NTree XNode -> Doc
    forall x. Pretty x => x -> Doc
    pretty

    instance Pretty XmlTree where
      pretty :: NTree XNode -> Doc
    pretty (NTree (XText String
    s) [NTree XNode]
    _) =
          String -> Doc
    text (String -> String
    textEscapeXml' String
    s)
        where
          -- | Auxiliary function to escape certain XML characters
          textEscapeXml' :: String -> String
          textEscapeXml' :: String -> String
    textEscapeXml' = (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Char -> String
    textEscapeChar
            where
              textEscapeChar :: Char -> String
    textEscapeChar Char
    '<' = String
    "&lt;"
              textEscapeChar Char
    '>' = String
    "&gt;"
              textEscapeChar Char
    '&' = String
    "&amp;"
              textEscapeChar Char
    x   = [Char
    x]

      pretty (NTree (XBlob Blob
    blob) [NTree XNode]
    _) =
        String -> Doc
    text (Blob -> String
    blobToString Blob
    blob)

      pretty (NTree (XCharRef Int
    ref) [NTree XNode]
    _) =
        String -> Doc
    text String
    "&#" Doc -> Doc -> Doc
    <> Int -> Doc
    int Int
    ref Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ';'

      pretty (NTree (XEntityRef String
    ref) [NTree XNode]
    _) =
        String -> Doc
    text String
    "&" Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ref Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ';'

      pretty (NTree (XCmt String
    comment) [NTree XNode]
    _) =
        String -> Doc
    text String
    "<!--" Doc -> Doc -> Doc
    <> String -> Doc
    text String
    comment Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "-->"

      pretty (NTree (XCdata String
    txt) [NTree XNode]
    _) =
          String -> Doc
    text String
    "<![CDATA[" Doc -> Doc -> Doc
    <> String -> Doc
    text String
    txt' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "]]>"
        where
          -- Escape "]]>" if present in the data contents
          txt' :: String
    txt' = (String -> String) -> String -> String -> String
    forall s. StringLike s => (s -> s) -> s -> s -> s
    sed (String -> String -> String
    forall a b. a -> b -> a
    const String
    "]]&gt;") String
    "\\]\\]>" String
    txt

      pretty (NTree (XPi QName
    iName [NTree XNode]
    attributes) [NTree XNode]
    _) =
             String -> Doc
    text String
    "<?"
          Doc -> Doc -> Doc
    <> QName -> Doc
    forall x. Pretty x => x -> Doc
    pretty QName
    iName
          Doc -> Doc -> Doc
    <> [Doc] -> Doc
    hcat ((NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NTree XNode -> Doc
    prettyPIAttr [NTree XNode]
    attributes)
          Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "?>"
        where
          -- Print an attribute of a processing instruction.
          prettyPIAttr :: XmlTree -> Doc
          prettyPIAttr :: NTree XNode -> Doc
    prettyPIAttr NTree XNode
    attrs
            | (NTree (XAttr QName
    attrQName) [NTree XNode]
    children) <- NTree XNode
    attrs
            , QName -> String
    qualifiedName QName
    attrQName String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    a_value
            = Doc
    space Doc -> Doc -> Doc
    <> [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    children

            -- <?xml version="..." ... ?>
            | Bool
    otherwise
            = NTree XNode -> Doc
    forall x. Pretty x => x -> Doc
    pretty NTree XNode
    attrs

      pretty (NTree (XTag QName
    tagQName [NTree XNode]
    attributeList) []) =
        Doc -> Doc
    angles (QName -> Doc
    forall x. Pretty x => x -> Doc
    pretty QName
    tagQName Doc -> Doc -> Doc
    <> [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    attributeList Doc -> Doc -> Doc
    <> Doc
    slash)

      pretty (NTree (XTag QName
    tagQName [NTree XNode]
    attributeList) [NTree XNode]
    children) =
           Doc -> Doc
    angles (QName -> Doc
    forall x. Pretty x => x -> Doc
    pretty QName
    tagQName Doc -> Doc -> Doc
    <> [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    attributeList) Doc -> Doc -> Doc
    <> [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    children
        Doc -> Doc -> Doc
    <> Doc -> Doc
    angles (Doc
    slash Doc -> Doc -> Doc
    <> QName -> Doc
    forall x. Pretty x => x -> Doc
    pretty QName
    tagQName)

      pretty (NTree (XDTD DTDElem
    dtdElem Attributes
    attributeList) [NTree XNode]
    children) =
        (DTDElem, Attributes, [NTree XNode]) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (DTDElem
    dtdElem, Attributes
    attributeList, [NTree XNode]
    children)

      pretty (NTree (XAttr QName
    attrQName) [NTree XNode]
    children) =
        Doc
    space Doc -> Doc -> Doc
    <> QName -> Doc
    forall x. Pretty x => x -> Doc
    pretty QName
    attrQName Doc -> Doc -> Doc
    <> Doc
    equals Doc -> Doc -> Doc
    <> Doc -> Doc
    doubleQuotes ([NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    children)

      pretty (NTree (XError Int
    level String
    txt) [NTree XNode]
    _) =
            String -> Doc
    text String
    "<!-- ERROR" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens (Int -> Doc
    int Int
    level) Doc -> Doc -> Doc
    <> Doc
    colon
        Doc -> Doc -> Doc
    <|> String -> Doc
    text String
    txt Doc -> Doc -> Doc
    <|> String -> Doc
    text String
    "-->"

    instance Pretty (DTDElem, Attributes, XmlTrees) where
      pretty :: (DTDElem, Attributes, [NTree XNode]) -> Doc
    pretty (DTDElem
    DOCTYPE, Attributes
    attributeList, [NTree XNode]
    children) =
              String -> Doc
    text String
    "<!DOCTYPE "
          Doc -> Doc -> Doc
    <>  (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
          Doc -> Doc -> Doc
    <>  Attributes -> Doc
    prettyExternalId Attributes
    attributeList
          Doc -> Doc -> Doc
    <+> [NTree XNode] -> Doc
    forall {a}. Pretty a => [a] -> Doc
    prettyInternalDTD [NTree XNode]
    children
          Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    ">"
        where
          prettyInternalDTD :: [a] -> Doc
    prettyInternalDTD [] = Doc
    empty
          prettyInternalDTD [a]
    ds = Doc -> Doc
    brackets (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc
    nl Doc -> Doc -> Doc
    <> [Doc] -> Doc
    vcat ((a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall x. Pretty x => x -> Doc
    pretty [a]
    ds)

      pretty (DTDElem
    ELEMENT, Attributes
    attributeList, [NTree XNode]
    children) =
            String -> Doc
    text String
    "<!ELEMENT "
        Doc -> Doc -> Doc
    <>  (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
        Doc -> Doc -> Doc
    <+> String -> [NTree XNode] -> Doc
    prettyElemType (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    a_type Attributes
    attributeList) [NTree XNode]
    children
        Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    " >"

      pretty (DTDElem
    CONTENT, Attributes
    attributeList, [NTree XNode]
    children) =
        NTree XNode -> Doc
    prettyContent (DTDElem -> Attributes -> [NTree XNode] -> NTree XNode
    mkDTDElem DTDElem
    CONTENT Attributes
    attributeList [NTree XNode]
    children)

      pretty (DTDElem
    ATTLIST, Attributes
    attributeList, [NTree XNode]
    children) =
             String -> Doc
    text String
    "<!ATTLIST "
          Doc -> Doc -> Doc
    <> ( if Maybe String -> Bool
    forall a. Maybe a -> Bool
    isNothing (String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    a_name Attributes
    attributeList)
                then [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    children
                else (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
                       Doc -> Doc -> Doc
    <+> Attributes -> [NTree XNode] -> Doc
    prettyValue Attributes
    attributeList [NTree XNode]
    children
             )
          Doc -> Doc -> Doc
    <> String -> Doc
    text String
    " >"

      pretty (DTDElem
    ENTITY, Attributes
    attributeList, [NTree XNode]
    children) =
        String -> Attributes -> [NTree XNode] -> Doc
    prettyEntity String
    "" Attributes
    attributeList [NTree XNode]
    children

      pretty (DTDElem
    PENTITY, Attributes
    attributeList, [NTree XNode]
    children) =
        String -> Attributes -> [NTree XNode] -> Doc
    prettyEntity String
    "% " Attributes
    attributeList [NTree XNode]
    children

      pretty (DTDElem
    NOTATION, Attributes
    attributeList, [NTree XNode]
    _children) =
           String -> Doc
    text String
    "<!NOTATION "
        Doc -> Doc -> Doc
    <> (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
        Doc -> Doc -> Doc
    <> Attributes -> Doc
    prettyExternalId Attributes
    attributeList
        Doc -> Doc -> Doc
    <> String -> Doc
    text String
    " >"

      pretty (DTDElem
    CONDSECT, Attributes
    _, NTree XNode
    child:[NTree XNode]
    children) =
           String -> Doc
    text String
    "<![ "
        Doc -> Doc -> Doc
    <> NTree XNode -> Doc
    forall x. Pretty x => x -> Doc
    pretty NTree XNode
    child
        Doc -> Doc -> Doc
    <> String -> Doc
    text String
    " [\n"
        Doc -> Doc -> Doc
    <> [NTree XNode] -> Doc
    forall x. Pretty x => x -> Doc
    pretty [NTree XNode]
    children
        Doc -> Doc -> Doc
    <> String -> Doc
    text String
    "]]>"

      pretty (DTDElem
    CONDSECT, Attributes
    _, []) =
        Doc
    empty

      pretty (DTDElem
    NAME, Attributes
    attributeList, [NTree XNode]
    _children) =
        (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)

      pretty (DTDElem
    PEREF, Attributes
    attributeList, [NTree XNode]
    _children) =
        Attributes -> Doc
    prettyPEAttr Attributes
    attributeList

    instance Pretty QName where
      pretty :: QName -> Doc
    pretty = String -> Doc
    text (String -> Doc) -> (QName -> String) -> QName -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> String
    qualifiedName

    instance Pretty (String, Attributes) where
      pretty :: (String, Attributes) -> Doc
    pretty (String
    k, Attributes
    attributeList) = String -> Doc
    text (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    k Attributes
    attributeList)

    -- * Auxiliary functions related to pretty printing XML trees.

    -- | Pretty print an attribute followed by its value.
    prettyAttr :: String -> Attributes -> Doc
    prettyAttr :: String -> Attributes -> Doc
    prettyAttr String
    k Attributes
    attributeList
      | Just String
    v <- String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    k Attributes
    attributeList
      = String -> Doc
    text String
    k Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    v
      | Bool
    otherwise
      = Doc
    empty

    -- | Pretty print a content element.
    prettyContent :: XmlTree -> Doc
    prettyContent :: NTree XNode -> Doc
    prettyContent (NTree (XDTD DTDElem
    NAME Attributes
    attributeList) [NTree XNode]
    _) =
      (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
    prettyContent (NTree (XDTD DTDElem
    PEREF Attributes
    attributeList) [NTree XNode]
    _) =
      Attributes -> Doc
    prettyPEAttr Attributes
    attributeList
    prettyContent (NTree (XDTD DTDElem
    CONTENT Attributes
    attributeList) [NTree XNode]
    children) =
           Doc -> Doc
    parens (Doc -> [Doc] -> Doc
    sepBy Doc
    separator ((NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NTree XNode -> Doc
    prettyContent [NTree XNode]
    children))
        Doc -> Doc -> Doc
    <> (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_modifier, Attributes
    attributeList)
      where
        separator :: Doc
    separator = String -> Doc
    text (if String
    a_kind String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_seq then String
    ", " else String
    " | ")
    prettyContent (NTree (XDTD DTDElem
    n Attributes
    _) [NTree XNode]
    _) =
      String -> Doc
    forall a. HasCallStack => String -> a
    error (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ String
    "prettyContent " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DTDElem -> String
    forall a. Show a => a -> String
    show DTDElem
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is undefined"
    prettyContent NTree XNode
    tree = NTree XNode -> Doc
    forall x. Pretty x => x -> Doc
    pretty NTree XNode
    tree

    -- | Pretty print the type of an element.
    prettyElemType :: String -> XmlTrees -> Doc
    prettyElemType :: String -> [NTree XNode] -> Doc
    prettyElemType String
    elemType [NTree XNode]
    children
        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_pcdata
        = Doc -> Doc
    parens (String -> Doc
    text String
    v_pcdata)

        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_mixed Bool -> Bool -> Bool
    && Bool -> Bool
    not ([NTree XNode] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [NTree XNode]
    children)
        , let [NTree (XDTD DTDElem
    CONTENT Attributes
    attributeList') [NTree XNode]
    children'] = [NTree XNode]
    children
        = Doc -> Doc
    parens
            ( Doc -> [Doc] -> Doc
    sepBy
                (String -> Doc
    text String
    " | ")
                ( String -> Doc
    text String
    v_pcdata
                Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes -> Doc
    prettyEnum (Attributes -> Doc)
    -> (NTree XNode -> Attributes) -> NTree XNode -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XNode -> Attributes
    treeElemAttributes(XNode -> Attributes)
    -> (NTree XNode -> XNode) -> NTree XNode -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NTree XNode -> XNode
    forall a. NTree a -> a
    forall (t :: * -> *) a. Tree t => t a -> a
    getNode) [NTree XNode]
    children'
                )
            )
        Doc -> Doc -> Doc
    <> (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_modifier, Attributes
    attributeList')

        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_mixed -- incorrect tree
        = Doc -> Doc
    parens Doc
    empty

        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_children Bool -> Bool -> Bool
    && Bool -> Bool
    not ([NTree XNode] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [NTree XNode]
    children)
        = NTree XNode -> Doc
    prettyContent ([NTree XNode] -> NTree XNode
    forall a. HasCallStack => [a] -> a
    head [NTree XNode]
    children)

        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    v_children
        = Doc -> Doc
    parens Doc
    empty

        | String
    elemType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_peref
        = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map NTree XNode -> Doc
    prettyContent [NTree XNode]
    children

        | Bool
    otherwise
        = String -> Doc
    text String
    elemType

      where
        treeElemAttributes :: XNode -> Attributes
    treeElemAttributes (XDTD DTDElem
    _ Attributes
    attributeList') = Attributes
    attributeList'
        treeElemAttributes (XText String
    txt) = [(String
    a_name, String
    txt)]
        treeElemAttributes XNode
    _           = []

    -- | Pretty print an entity.
    prettyEntity :: String -> Attributes -> XmlTrees -> Doc
    prettyEntity :: String -> Attributes -> [NTree XNode] -> Doc
    prettyEntity String
    kind Attributes
    attributeList [NTree XNode]
    children =
          String -> Doc
    text String
    "<!ENTITY "
      Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    kind
      Doc -> Doc -> Doc
    <>  (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributeList)
      Doc -> Doc -> Doc
    <>  Attributes -> Doc
    prettyExternalId Attributes
    attributeList
      Doc -> Doc -> Doc
    <+> String -> Attributes -> Doc
    prettyAttr String
    k_ndata Attributes
    attributeList
      Doc -> Doc -> Doc
    <+> [NTree XNode] -> Doc
    prettyLiteralTrees [NTree XNode]
    children
      Doc -> Doc -> Doc
    <>  String -> Doc
    text String
    " >"

    -- | Pretty print trees as text, quoting them.
    prettyLiteralTrees :: XmlTrees -> Doc
    prettyLiteralTrees :: [NTree XNode] -> Doc
    prettyLiteralTrees []       = Doc
    empty
    prettyLiteralTrees [NTree XNode]
    children = Doc -> Doc
    doubleQuotes (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ String -> Doc
    text (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ [NTree XNode] -> String
    xshow [NTree XNode]
    children

    -- | Pretty print an external ID.
    prettyExternalId :: Attributes -> Doc
    prettyExternalId :: Attributes -> Doc
    prettyExternalId Attributes
    attributeList =
      case (String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    k_system Attributes
    attributeList, String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    k_public Attributes
    attributeList) of
        (Maybe String
    Nothing, Maybe String
    Nothing) -> Doc
    empty
        (Just String
    s,  Maybe String
    Nothing) -> String -> Doc
    text String
    k_system Doc -> Doc -> Doc
    <+> Doc -> Doc
    doubleQuotes (String -> Doc
    text String
    s)
        (Maybe String
    Nothing, Just String
    p ) -> Doc
    space Doc -> Doc -> Doc
    <> String -> Doc
    text String
    k_public Doc -> Doc -> Doc
    <+> Doc -> Doc
    doubleQuotes (String -> Doc
    text String
    p)
        (Just String
    s,  Just String
    p ) -> Doc
    space Doc -> Doc -> Doc
    <> String -> Doc
    text String
    k_public Doc -> Doc -> Doc
    <+> Doc -> Doc
    doubleQuotes (String -> Doc
    text String
    p)
                                Doc -> Doc -> Doc
    <+> Doc -> Doc
    doubleQuotes (String -> Doc
    text String
    s)

    -- | Pretty print a Parameter Entity Reference.
    prettyPEAttr :: Attributes -> Doc
    prettyPEAttr :: Attributes -> Doc
    prettyPEAttr = Doc -> (String -> Doc) -> Maybe String -> Doc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc
    empty (\String
    pe -> Char -> Doc
    char Char
    '%' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    pe Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ';')
                 (Maybe String -> Doc)
    -> (Attributes -> Maybe String) -> Attributes -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    a_peref

    -- | Given a list of attributes, pretty print the value in them.
    prettyValue :: Attributes -> XmlTrees -> Doc
    prettyValue :: Attributes -> [NTree XNode] -> Doc
    prettyValue Attributes
    attributeList [NTree XNode]
    children
        | Just String
    aValue <- String -> Attributes -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    a_value Attributes
    attributeList
        =     String -> Doc
    text String
    aValue
          Doc -> Doc -> Doc
    <+> String -> Doc
    prettyAttrType (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    a_type Attributes
    attributeList)
          Doc -> Doc -> Doc
    <+> String -> Doc
    prettyAttrKind (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    a_kind Attributes
    attributeList)

        | Bool
    otherwise
        = Attributes -> Doc
    prettyPEAttr (Attributes -> Doc) -> Attributes -> Doc
    forall a b. (a -> b) -> a -> b
    $ Attributes -> Maybe Attributes -> Attributes
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe Attributes -> Attributes) -> Maybe Attributes -> Attributes
    forall a b. (a -> b) -> a -> b
    $ NTree XNode -> Maybe Attributes
    forall a. XmlNode a => a -> Maybe Attributes
    getDTDAttrl (NTree XNode -> Maybe Attributes)
    -> NTree XNode -> Maybe Attributes
    forall a b. (a -> b) -> a -> b
    $ [NTree XNode] -> NTree XNode
    forall a. HasCallStack => [a] -> a
    head [NTree XNode]
    children
      where

        prettyAttrType :: String -> Doc
    prettyAttrType String
    attrType
          | String
    attrType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_peref       = Attributes -> Doc
    prettyPEAttr Attributes
    attributeList
          | String
    attrType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_enumeration = Doc
    prettyAttrEnum
          | String
    attrType String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_notation    = String -> Doc
    text String
    k_notation Doc -> Doc -> Doc
    <+> Doc
    prettyAttrEnum
          | Bool
    otherwise                 = String -> Doc
    text String
    attrType

        prettyAttrEnum :: Doc
    prettyAttrEnum =
            Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Doc -> [Doc] -> Doc
    sepBy (String -> Doc
    text String
    " | ") ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
              (NTree XNode -> Doc) -> [NTree XNode] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes -> Doc
    prettyEnum (Attributes -> Doc)
    -> (NTree XNode -> Attributes) -> NTree XNode -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Attributes -> Maybe Attributes -> Attributes
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe Attributes -> Attributes)
    -> (NTree XNode -> Maybe Attributes) -> NTree XNode -> Attributes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NTree XNode -> Maybe Attributes
    forall a. XmlNode a => a -> Maybe Attributes
    getDTDAttrl) [NTree XNode]
    children
          where

        prettyAttrKind :: String -> Doc
    prettyAttrKind String
    kind
          | String
    kind String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_default
          = Doc -> Doc
    doubleQuotes (String -> Doc
    text (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    a_default Attributes
    attributeList))

          | String
    kind String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_fixed
          = String -> Doc
    text String
    k_fixed
            Doc -> Doc -> Doc
    <+> Doc -> Doc
    doubleQuotes (String -> Doc
    text (String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    a_default Attributes
    attributeList))

          | Bool
    otherwise
          = String -> Doc
    text String
    kind

    -- Pretty print the name of an attribute, followed by the PE Reference.
    prettyEnum :: Attributes -> Doc
    prettyEnum :: Attributes -> Doc
    prettyEnum Attributes
    attributes = (String, Attributes) -> Doc
    forall x. Pretty x => x -> Doc
    pretty (String
    a_name, Attributes
    attributes) Doc -> Doc -> Doc
    <> Attributes -> Doc
    prettyPEAttr Attributes
    attributes

    -- ** Generic document constructors

    -- | Forward slash character.
    slash :: Doc
    slash :: Doc
    slash = Char -> Doc
    char Char
    '/'

    -- | New line character.
    nl :: Doc
    nl :: Doc
    nl = Char -> Doc
    char Char
    '\n'

    -- | Enclose document in angle brackets.
    angles :: Doc -> Doc
    angles :: Doc -> Doc
    angles Doc
    s = Char -> Doc
    char Char
    '<' Doc -> Doc -> Doc
    <> Doc
    s Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '>'

    -- | Compose two documents, separating them by a new line.
    --
    -- The new line is not inserted if either document is empty.
    (<|>) :: Doc -> Doc -> Doc
    <|> :: Doc -> Doc -> Doc
    (<|>) Doc
    x Doc
    y
      | Doc -> Bool
    isEmpty Doc
    x = Doc
    y
      | Doc -> Bool
    isEmpty Doc
    y = Doc
    x
      | Bool
    otherwise = Doc
    x Doc -> Doc -> Doc
    <> Doc
    nl Doc -> Doc -> Doc
    <> Doc
    y

    -- | Concatenate a list od documents, separating them by a given separator.
    sepBy :: Doc   -- ^ Separator
          -> [Doc] -- ^ List of documents
          -> Doc
    sepBy :: Doc -> [Doc] -> Doc
    sepBy Doc
    _   []     = Doc
    empty
    sepBy Doc
    _   [Doc
    x]    = Doc
    x
    sepBy Doc
    sep (Doc
    x:[Doc]
    xs) = Doc
    x Doc -> Doc -> Doc
    <> Doc
    sep Doc -> Doc -> Doc
    <> Doc -> [Doc] -> Doc
    sepBy Doc
    sep [Doc]
    xs