    {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

    -- |
    -- Module    :  Data.XCB.Pretty
    -- Copyright :  (c) Antoine Latter 2008
    -- License   :  BSD3
    --
    -- Maintainer:  Antoine Latter <aslatter@gmail.com>
    -- Stability :  provisional
    -- Portability: portable - requires TypeSynonymInstances
    --
    -- Pretty-printers for the tyes declared in this package.
    -- This does NOT ouput XML - it produces human-readable information
    -- intended to aid in debugging.
    module Data.XCB.Pretty where

    import Prelude hiding ((<>))

    import Data.XCB.Types

    import Text.PrettyPrint.HughesPJ

    import qualified Data.Map as Map
    import Data.Maybe

    -- |Minimal complete definition:
    --
    -- One of 'pretty' or 'toDoc'.
    class Pretty a where
        toDoc :: a -> Doc
        pretty :: a -> String

        pretty = Doc -> String
    forall a. Show a => a -> String
    show (Doc -> String) -> (a -> Doc) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc
        toDoc = String -> Doc
    text (String -> Doc) -> (a -> String) -> a -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Pretty a => a -> String
    pretty

    -- Builtin types

    instance Pretty String where
        pretty :: String -> String
    pretty = String -> String
    forall a. Show a => a -> String
    show

    instance Pretty Int where
        pretty :: Int -> String
    pretty = Int -> String
    forall a. Show a => a -> String
    show

    instance Pretty Bool where
        pretty :: Bool -> String
    pretty = Bool -> String
    forall a. Show a => a -> String
    show

    instance Pretty a => Pretty (Maybe a) where
        toDoc :: Maybe a -> Doc
    toDoc Maybe a
    Nothing = Doc
    empty
        toDoc (Just a
    a) = a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    a

        pretty :: Maybe a -> String
    pretty Maybe a
    Nothing = String
    ""
        pretty (Just a
    a) = a -> String
    forall a. Pretty a => a -> String
    pretty a
    a

    -- Simple stuff

    instance Pretty a => Pretty (GenXidUnionElem a) where
        toDoc :: GenXidUnionElem a -> Doc
    toDoc (XidUnionElem a
    t) = a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    t

    instance Pretty Binop where
        pretty :: Binop -> String
    pretty Binop
    Add  = String
    "+"
        pretty Binop
    Sub  = String
    "-"
        pretty Binop
    Mult = String
    "*"
        pretty Binop
    Div  = String
    "/"
        pretty Binop
    RShift = String
    ">>"
        pretty Binop
    And = String
    "&"

    instance Pretty Unop where
        pretty :: Unop -> String
    pretty Unop
    Complement = String
    "~"

    instance Pretty a => Pretty (EnumElem a) where
        toDoc :: EnumElem a -> Doc
    toDoc (EnumElem String
    name Maybe (Expression a)
    expr)
            = String -> Doc
    text String
    name Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <+> Maybe (Expression a) -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe (Expression a)
    expr

    instance Pretty Type where
        toDoc :: Type -> Doc
    toDoc (UnQualType String
    name) = String -> Doc
    text String
    name
        toDoc (QualType String
    modifier String
    name)
            = String -> Doc
    text String
    modifier Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '.' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    name

    -- More complex stuff

    instance Pretty a => Pretty (Expression a) where
        toDoc :: Expression a -> Doc
    toDoc (Value Int
    n) = Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n
        toDoc (Bit Int
    n) = String -> Doc
    text String
    "2^" Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n
        toDoc (FieldRef String
    ref) = Char -> Doc
    char Char
    '$' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ref
        toDoc (EnumRef a
    typ String
    child)
            = a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    '.' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    child
        toDoc (PopCount Expression a
    expr)
            = String -> Doc
    text String
    "popcount" Doc -> Doc -> Doc
    <> Doc -> Doc
    parens (Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr)
        toDoc (SumOf String
    ref)
            = String -> Doc
    text String
    "sumof" Doc -> Doc -> Doc
    <> (Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Char -> Doc
    char Char
    '$' Doc -> Doc -> Doc
    <> String -> Doc
    text String
    ref)
        toDoc (Op Binop
    binop Expression a
    exprL Expression a
    exprR)
            = Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    hsep [Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    exprL
                            ,Binop -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Binop
    binop
                            ,Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    exprR
                            ]
        toDoc (Unop Unop
    op Expression a
    expr)
            = Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Unop -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Unop
    op Doc -> Doc -> Doc
    <> Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr
        toDoc (ParamRef String
    n) = String -> Doc
    forall a. Pretty a => a -> Doc
    toDoc String
    n

    instance Pretty PadType where
        pretty :: PadType -> String
    pretty PadType
    PadBytes = String
    "bytes"
        pretty PadType
    PadAlignment = String
    "align"

    instance Pretty a => Pretty (GenStructElem a) where
        toDoc :: GenStructElem a -> Doc
    toDoc (Pad PadType
    typ Int
    n) = Doc -> Doc
    braces (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n Doc -> Doc -> Doc
    <+> PadType -> Doc
    forall a. Pretty a => a -> Doc
    toDoc PadType
    typ
        toDoc (List String
    nm a
    typ Maybe (Expression a)
    len Maybe a
    enums)
            = String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> Doc -> Doc
    brackets (a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ Doc -> Doc -> Doc
    <+> Maybe a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe a
    enums) Doc -> Doc -> Doc
    <+> Maybe (Expression a) -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe (Expression a)
    len
        toDoc (SField String
    nm a
    typ Maybe a
    enums Maybe a
    mask) = [Doc] -> Doc
    hsep [String -> Doc
    text String
    nm
                                                ,String -> Doc
    text String
    "::"
                                                ,a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ
                                                ,Maybe a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe a
    enums
                                                ,Maybe a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe a
    mask
                                                ]
        toDoc (ExprField String
    nm a
    typ Expression a
    expr)
            = Doc -> Doc
    parens (String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+> a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ)
              Doc -> Doc -> Doc
    <+> Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr
        toDoc (Switch String
    name Expression a
    expr Maybe Alignment
    alignment [GenBitCase a]
    cases)
            = [Doc] -> Doc
    vcat
               [ String -> Doc
    text String
    "switch" Doc -> Doc -> Doc
    <> Doc -> Doc
    parens (Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr) Doc -> Doc -> Doc
    <> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment Doc -> Doc -> Doc
    <> Doc -> Doc
    brackets (String -> Doc
    text String
    name)
               , Doc -> Doc
    braces ([Doc] -> Doc
    vcat ((GenBitCase a -> Doc) -> [GenBitCase a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenBitCase a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenBitCase a]
    cases))
               ]
        toDoc (Doc Maybe String
    brief Map String String
    fields [(String, String)]
    see)
            = String -> Doc
    text String
    "Doc" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "brief=" Doc -> Doc -> Doc
    <+> String -> Doc
    text (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" Maybe String
    brief) Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "fields=" Doc -> Doc -> Doc
    <+>
              [Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate (Char -> Doc
    char Char
    ',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Doc]
    joinWith String
    ":" ([(String, String)] -> [Doc]) -> [(String, String)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map String String
    fields) Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    ";" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "see=" Doc -> Doc -> Doc
    <+>
              [Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate (Char -> Doc
    char Char
    ',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Doc]
    joinWith String
    "." [(String, String)]
    see)

            where
              joinWith :: String -> [(String, String)] -> [Doc]
    joinWith String
    c = ((String, String) -> Doc) -> [(String, String)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (((String, String) -> Doc) -> [(String, String)] -> [Doc])
    -> ((String, String) -> Doc) -> [(String, String)] -> [Doc]
    forall a b. (a -> b) -> a -> b
    $ \(String
    x,String
    y) -> String -> Doc
    text (String -> Doc) -> String -> Doc
    forall a b. (a -> b) -> a -> b
    $ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    y

        toDoc (Fd String
    fd)
            = String -> Doc
    text String
    "Fd" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    fd
        toDoc (ValueParam a
    typ String
    mname Maybe Int
    mpad String
    lname)
            = String -> Doc
    text String
    "Valueparam" Doc -> Doc -> Doc
    <+>
              String -> Doc
    text String
    "::" Doc -> Doc -> Doc
    <+>
              [Doc] -> Doc
    hsep (Doc -> [Doc] -> [Doc]
    punctuate (Char -> Doc
    char Char
    ',') [Doc]
    details)

            where details :: [Doc]
    details
                      | Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Int
    mpad =
                          [a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ
                          ,String -> Doc
    text String
    "mask padding:" Doc -> Doc -> Doc
    <+> Maybe Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Int
    mpad
                          ,String -> Doc
    text String
    mname
                          ,String -> Doc
    text String
    lname
                          ]
                      | Bool
    otherwise =
                          [a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ
                          ,String -> Doc
    text String
    mname
                          ,String -> Doc
    text String
    lname
                          ]
        toDoc (Length a
    _ Expression a
    expr)
            = String -> Doc
    text String
    "length" Doc -> Doc -> Doc
    <+> Doc -> Doc
    parens (Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr)

    instance Pretty a => Pretty (GenBitCase a) where
        toDoc :: GenBitCase a -> Doc
    toDoc (BitCase Maybe String
    name Expression a
    expr Maybe Alignment
    alignment [GenStructElem a]
    fields)
            = [Doc] -> Doc
    vcat
               [ Maybe String -> Expression a -> Doc
    forall a. Pretty a => Maybe String -> Expression a -> Doc
    bitCaseHeader Maybe String
    name Expression a
    expr
               , Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment
               , Doc -> Doc
    braces ([Doc] -> Doc
    vcat ((GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    fields))
               ]

    bitCaseHeader :: Pretty a => Maybe Name -> Expression a -> Doc
    bitCaseHeader :: forall a. Pretty a => Maybe String -> Expression a -> Doc
    bitCaseHeader Maybe String
    Nothing Expression a
    expr =
        String -> Doc
    text String
    "bitcase" Doc -> Doc -> Doc
    <> Doc -> Doc
    parens (Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr)
    bitCaseHeader (Just String
    name) Expression a
    expr =
        String -> Doc
    text String
    "bitcase" Doc -> Doc -> Doc
    <> Doc -> Doc
    parens (Expression a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Expression a
    expr) Doc -> Doc -> Doc
    <> Doc -> Doc
    brackets (String -> Doc
    text String
    name)

    instance Pretty Alignment where
        toDoc :: Alignment -> Doc
    toDoc (Alignment Int
    align Int
    offset) = String -> Doc
    text String
    "alignment" Doc -> Doc -> Doc
    <+>
                                           String -> Doc
    text String
    "align=" Doc -> Doc -> Doc
    <+> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    align Doc -> Doc -> Doc
    <+>
                                           String -> Doc
    text String
    "offset=" Doc -> Doc -> Doc
    <+> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    offset

    instance Pretty AllowedEvent where
        toDoc :: AllowedEvent -> Doc
    toDoc (AllowedEvent String
    extension Bool
    xge Int
    opMin Int
    opMax) = String -> Doc
    text String
    "allowed" Doc -> Doc -> Doc
    <+>
                                                           String -> Doc
    text String
    "extension=" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    extension Doc -> Doc -> Doc
    <+>
                                                           String -> Doc
    text String
    "xge=" Doc -> Doc -> Doc
    <> Bool -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Bool
    xge Doc -> Doc -> Doc
    <>
                                                           String -> Doc
    text String
    "opcode-min" Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    opMin Doc -> Doc -> Doc
    <>
                                                           String -> Doc
    text String
    "opcode-max" Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    opMax

    instance Pretty a => Pretty (GenXDecl a) where
        toDoc :: GenXDecl a -> Doc
    toDoc (XStruct String
    nm Maybe Alignment
    alignment [GenStructElem a]
    elems) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Struct:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems
        toDoc (XTypeDef String
    nm a
    typ) = [Doc] -> Doc
    hsep [String -> Doc
    text String
    "TypeDef:"
                                        ,String -> Doc
    text String
    nm
                                        ,String -> Doc
    text String
    "as"
                                        ,a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc a
    typ
                                        ]
        toDoc (XEvent String
    nm Int
    n Maybe Alignment
    alignment Maybe Bool
    _ [GenStructElem a]
    elems (Just Bool
    True)) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Event:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ',' Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment Doc -> Doc -> Doc
    <+>
                 Doc -> Doc
    parens (String -> Doc
    text String
    "No sequence number")) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                 [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems
        toDoc (XEvent String
    nm Int
    n Maybe Alignment
    alignment Maybe Bool
    _ [GenStructElem a]
    elems Maybe Bool
    _) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Event:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ',' Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                 [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems
        toDoc (XRequest String
    nm Int
    n Maybe Alignment
    alignment [GenStructElem a]
    elems Maybe (GenXReply a)
    mrep) =
            (Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Request:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ',' Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                 [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems)
             Doc -> Doc -> Doc
    $$ case Maybe (GenXReply a)
    mrep of
                 Maybe (GenXReply a)
    Nothing -> Doc
    empty
                 Just (GenXReply Maybe Alignment
    repAlignment [GenStructElem a]
    reply) ->
                     Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Reply:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <> Char -> Doc
    char Char
    ',' Doc -> Doc -> Doc
    <> Int -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Int
    n Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    repAlignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                          [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    reply
        toDoc (XidType String
    nm) = String -> Doc
    text String
    "XID:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm
        toDoc (XidUnion String
    nm [GenXidUnionElem a]
    elems) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "XID" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "Union:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $
                 [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenXidUnionElem a -> Doc) -> [GenXidUnionElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenXidUnionElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenXidUnionElem a]
    elems
        toDoc (XEnum String
    nm [EnumElem a]
    elems) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Enum:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (EnumElem a -> Doc) -> [EnumElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map EnumElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [EnumElem a]
    elems
        toDoc (XUnion String
    nm Maybe Alignment
    alignment [GenStructElem a]
    elems) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Union:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems
        toDoc (XImport String
    nm) = String -> Doc
    text String
    "Import:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm
        toDoc (XError String
    nm Int
    _n Maybe Alignment
    alignment [GenStructElem a]
    elems) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Error:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    nm Doc -> Doc -> Doc
    <+> Maybe Alignment -> Doc
    forall a. Pretty a => a -> Doc
    toDoc Maybe Alignment
    alignment) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenStructElem a -> Doc) -> [GenStructElem a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStructElem a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [GenStructElem a]
    elems
        toDoc (XEventStruct String
    name [AllowedEvent]
    allowed) =
            Doc -> Int -> Doc -> Doc
    hang (String -> Doc
    text String
    "Event struct:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    name) Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (AllowedEvent -> Doc) -> [AllowedEvent] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map AllowedEvent -> Doc
    forall a. Pretty a => a -> Doc
    toDoc [AllowedEvent]
    allowed

    instance Pretty a => Pretty (GenXHeader a) where
        toDoc :: GenXHeader a -> Doc
    toDoc GenXHeader a
    xhd = String -> Doc
    text (GenXHeader a -> String
    forall typ. GenXHeader typ -> String
    xheader_header GenXHeader a
    xhd) Doc -> Doc -> Doc
    $$
                    ([Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (GenXDecl a -> Doc) -> [GenXDecl a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenXDecl a -> Doc
    forall a. Pretty a => a -> Doc
    toDoc (GenXHeader a -> [GenXDecl a]
    forall typ. GenXHeader typ -> [GenXDecl typ]
    xheader_decls GenXHeader a
    xhd))