{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
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
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
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
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
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
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))