{-# 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 Nothing = Doc
empty
    toDoc (Just a :: a
a) = a -> Doc
forall a. Pretty a => a -> Doc
toDoc a
a

    pretty :: Maybe a -> String
pretty Nothing = ""
    pretty (Just a :: 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 t :: a
t) = a -> Doc
forall a. Pretty a => a -> Doc
toDoc a
t

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

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

instance Pretty a => Pretty (EnumElem a) where
    toDoc :: EnumElem a -> Doc
toDoc (EnumElem name :: String
name expr :: Maybe (Expression a)
expr)
        = String -> Doc
text String
name Doc -> Doc -> Doc
<> Char -> Doc
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 name :: String
name) = String -> Doc
text String
name
    toDoc (QualType modifier :: String
modifier name :: String
name)
        = String -> Doc
text String
modifier Doc -> Doc -> Doc
<> Char -> Doc
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 n :: Int
n) = Int -> Doc
forall a. Pretty a => a -> Doc
toDoc Int
n
    toDoc (Bit n :: Int
n) = String -> Doc
text "2^" Doc -> Doc -> Doc
<> Int -> Doc
forall a. Pretty a => a -> Doc
toDoc Int
n
    toDoc (FieldRef ref :: String
ref) = Char -> Doc
char '$' Doc -> Doc -> Doc
<> String -> Doc
text String
ref
    toDoc (EnumRef typ :: a
typ child :: String
child)
        = a -> Doc
forall a. Pretty a => a -> Doc
toDoc a
typ Doc -> Doc -> Doc
<> Char -> Doc
char '.' Doc -> Doc -> Doc
<> String -> Doc
text String
child
    toDoc (PopCount expr :: Expression a
expr)
        = String -> Doc
text "popcount" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expression a -> Doc
forall a. Pretty a => a -> Doc
toDoc Expression a
expr)
    toDoc (SumOf ref :: String
ref)
        = String -> Doc
text "sumof" Doc -> Doc -> Doc
<> (Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '$' Doc -> Doc -> Doc
<> String -> Doc
text String
ref)
    toDoc (Op binop :: Binop
binop exprL :: Expression a
exprL exprR :: 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 op :: Unop
op expr :: 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 n :: String
n) = String -> Doc
forall a. Pretty a => a -> Doc
toDoc String
n

instance Pretty a => Pretty (GenStructElem a) where
    toDoc :: GenStructElem a -> Doc
toDoc (Pad n :: 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
<+> String -> Doc
text "bytes"
    toDoc (List nm :: String
nm typ :: a
typ len :: Maybe (Expression a)
len enums :: Maybe a
enums)
        = String -> Doc
text String
nm Doc -> Doc -> Doc
<+> String -> Doc
text "::" 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 nm :: String
nm typ :: a
typ enums :: Maybe a
enums mask :: Maybe a
mask) = [Doc] -> Doc
hsep [String -> Doc
text String
nm
                                            ,String -> Doc
text "::"
                                            ,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 nm :: String
nm typ :: a
typ expr :: Expression a
expr)
        = Doc -> Doc
parens (String -> Doc
text String
nm Doc -> Doc -> Doc
<+> String -> Doc
text "::" 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 name :: String
name expr :: Expression a
expr alignment :: Maybe Alignment
alignment cases :: [GenBitCase a]
cases)
        = [Doc] -> Doc
vcat
           [ String -> Doc
text "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 brief :: Maybe String
brief fields :: Map String String
fields see :: [(String, String)]
see)
        = String -> Doc
text "Doc" Doc -> Doc -> Doc
<+>
          String -> Doc
text "::" Doc -> Doc -> Doc
<+>
          String -> Doc
text "brief=" Doc -> Doc -> Doc
<+> String -> Doc
text (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" Maybe String
brief) Doc -> Doc -> Doc
<+>
          String -> Doc
text "fields=" Doc -> Doc -> Doc
<+>
          [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char ',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Doc]
joinWith ":" ([(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 ";" Doc -> Doc -> Doc
<+>
          String -> Doc
text "see=" Doc -> Doc -> Doc
<+>
          [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char ',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> [Doc]
joinWith "." [(String, String)]
see)

        where
          joinWith :: String -> [(String, String)] -> [Doc]
joinWith c :: 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
$ \(x :: String
x,y :: 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 fd :: String
fd)
        = String -> Doc
text "Fd" Doc -> Doc -> Doc
<+>
          String -> Doc
text "::" Doc -> Doc -> Doc
<+>
          String -> Doc
text String
fd
    toDoc (ValueParam typ :: a
typ mname :: String
mname mpad :: Maybe Int
mpad lname :: String
lname)
        = String -> Doc
text "Valueparam" Doc -> Doc -> Doc
<+>
          String -> Doc
text "::" Doc -> Doc -> Doc
<+>
          [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
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 "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
                      ]


instance Pretty a => Pretty (GenBitCase a) where
    toDoc :: GenBitCase a -> Doc
toDoc (BitCase name :: Maybe String
name expr :: Expression a
expr alignment :: Maybe Alignment
alignment fields :: [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 :: Maybe String -> Expression a -> Doc
bitCaseHeader Nothing expr :: Expression a
expr =
    String -> Doc
text "bitcase" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expression a -> Doc
forall a. Pretty a => a -> Doc
toDoc Expression a
expr)
bitCaseHeader (Just name :: String
name) expr :: Expression a
expr =
    String -> Doc
text "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 align :: Int
align offset :: Int
offset) = String -> Doc
text "alignment" Doc -> Doc -> Doc
<+>
                                       String -> Doc
text "align=" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
toDoc Int
align Doc -> Doc -> Doc
<+>
                                       String -> Doc
text "offset=" Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
toDoc Int
offset

instance Pretty AllowedEvent where
    toDoc :: AllowedEvent -> Doc
toDoc (AllowedEvent extension :: String
extension xge :: Bool
xge opMin :: Int
opMin opMax :: Int
opMax) = String -> Doc
text "allowed" Doc -> Doc -> Doc
<+>
                                                       String -> Doc
text "extension=" Doc -> Doc -> Doc
<+> String -> Doc
text String
extension Doc -> Doc -> Doc
<+>
                                                       String -> Doc
text "xge=" Doc -> Doc -> Doc
<> Bool -> Doc
forall a. Pretty a => a -> Doc
toDoc Bool
xge Doc -> Doc -> Doc
<>
                                                       String -> Doc
text "opcode-min" Doc -> Doc -> Doc
<> Int -> Doc
forall a. Pretty a => a -> Doc
toDoc Int
opMin Doc -> Doc -> Doc
<>
                                                       String -> Doc
text "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 nm :: String
nm alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "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) 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 nm :: String
nm typ :: a
typ) = [Doc] -> Doc
hsep [String -> Doc
text "TypeDef:"
                                    ,String -> Doc
text String
nm
                                    ,String -> Doc
text "as"
                                    ,a -> Doc
forall a. Pretty a => a -> Doc
toDoc a
typ
                                    ]
    toDoc (XEvent nm :: String
nm n :: Int
n alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems (Just True)) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Event:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm Doc -> Doc -> Doc
<> Char -> Doc
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 "No sequence number")) 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 nm :: String
nm n :: Int
n alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems _) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Event:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm Doc -> Doc -> Doc
<> Char -> Doc
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) 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 nm :: String
nm n :: Int
n alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems mrep :: Maybe (GenXReply a)
mrep) = 
        (Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Request:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm Doc -> Doc -> Doc
<> Char -> Doc
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) 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
             Nothing -> Doc
empty
             Just (GenXReply repAlignment :: Maybe Alignment
repAlignment reply :: [GenStructElem a]
reply) ->
                 Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Reply:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm Doc -> Doc -> Doc
<> Char -> Doc
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) 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 nm :: String
nm) = String -> Doc
text "XID:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm
    toDoc (XidUnion nm :: String
nm elems :: [GenXidUnionElem a]
elems) = 
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "XID" Doc -> Doc -> Doc
<+> String -> Doc
text "Union:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm) 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 nm :: String
nm elems :: [EnumElem a]
elems) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Enum:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm) 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 nm :: String
nm alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems) = 
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "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) 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 nm :: String
nm) = String -> Doc
text "Import:" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm
    toDoc (XError nm :: String
nm _n :: Int
_n alignment :: Maybe Alignment
alignment elems :: [GenStructElem a]
elems) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "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) 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 name :: String
name allowed :: [AllowedEvent]
allowed) =
        Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "Event struct:" Doc -> Doc -> Doc
<+> String -> Doc
text String
name) 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 xhd :: 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))