module Language.Cimple.Pretty (ppTranslationUnit) where

import qualified Data.List                    as List
import           Data.Text                    (Text)
import qualified Data.Text                    as Text
import           Language.Cimple              (AssignOp (..), BinaryOp (..),
                                               CommentStyle (..), Lexeme (..),
                                               LexemeClass (..), Node (..),
                                               Scope (..), UnaryOp (..),
                                               lexemeText)
import           Prelude                      hiding ((<$>))
import           Text.Groom                   (groom)
import           Text.PrettyPrint.ANSI.Leijen

ppText :: Text -> Doc
ppText :: Text -> Doc
ppText = String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

ppLexeme :: Lexeme Text -> Doc
ppLexeme :: Lexeme Text -> Doc
ppLexeme = Text -> Doc
ppText (Text -> Doc) -> (Lexeme Text -> Text) -> Lexeme Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Text
forall text. Lexeme text -> text
lexemeText

ppCommaSep :: (a -> Doc) -> [a] -> Doc
ppCommaSep :: (a -> Doc) -> [a] -> Doc
ppCommaSep a -> Doc
go = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
empty ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (String -> Doc
text String
", ") ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
go

ppLineSep :: (a -> Doc) -> [a] -> Doc
ppLineSep :: (a -> Doc) -> [a] -> Doc
ppLineSep a -> Doc
go = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) Doc
empty ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse Doc
linebreak ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
go

ppComment :: Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment :: CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment CommentStyle
style [Node a (Lexeme Text)]
cs =
    Int -> Doc -> Doc
nest Int
1 (CommentStyle -> Doc
ppCommentStyle CommentStyle
style Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppCommentBody [Node a (Lexeme Text)]
cs) Doc -> Doc -> Doc
<+> String -> Doc
text String
"*/"

ppCommentStyle :: CommentStyle -> Doc
ppCommentStyle :: CommentStyle -> Doc
ppCommentStyle CommentStyle
Block   = String -> Doc
text String
"/***"
ppCommentStyle CommentStyle
Doxygen = String -> Doc
text String
"/**"
ppCommentStyle CommentStyle
Regular = String -> Doc
text String
"/*"

ppCommentWords :: [Lexeme Text] -> Doc
ppCommentWords :: [Lexeme Text] -> Doc
ppCommentWords = [Lexeme Text] -> Doc
go
  where
    go :: [Lexeme Text] -> Doc
go (L AlexPosn
_ LexemeClass
LitInteger Text
t1 : L AlexPosn
_ LexemeClass
PctMinus Text
m : L AlexPosn
_ LexemeClass
LitInteger Text
t2 : [Lexeme Text]
xs) =
        Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
m Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
go [Lexeme Text]
xs
    go (L AlexPosn
_ LexemeClass
PctMinus Text
m : L AlexPosn
_ LexemeClass
LitInteger Text
t : [Lexeme Text]
xs) =
        Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
m Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
go [Lexeme Text]
xs

    go (Lexeme Text
l : L AlexPosn
_ LexemeClass
PctPeriod Text
t : [Lexeme Text]
xs) = [Lexeme Text] -> Doc
go [Lexeme Text
l] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
go [Lexeme Text]
xs
    go (Lexeme Text
l : L AlexPosn
_ LexemeClass
PctComma  Text
t : [Lexeme Text]
xs) = [Lexeme Text] -> Doc
go [Lexeme Text
l] Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
go [Lexeme Text]
xs
    go (Lexeme Text
x                   : [Lexeme Text]
xs) = Lexeme Text -> Doc
ppWord Lexeme Text
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
go [Lexeme Text]
xs
    go []                         = Doc
empty

    ppWord :: Lexeme Text -> Doc
ppWord (L AlexPosn
_ LexemeClass
CmtSpdxLicense   Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
CmtSpdxCopyright Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
CmtWord          Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
CmtCode          Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
CmtRef           Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
CmtIndent        Text
_) = Char -> Doc
char Char
'*'
    ppWord (L AlexPosn
_ LexemeClass
PpNewline        Text
_) = Doc
linebreak
    ppWord (L AlexPosn
_ LexemeClass
LitInteger       Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
LitString        Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctEMark         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctPlus          Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctEq            Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctMinus         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctPeriod        Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctLParen        Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctRParen        Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctSemicolon     Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctColon         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctQMark         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctSlash         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctGreater       Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctLess          Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord (L AlexPosn
_ LexemeClass
PctComma         Text
t) = Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
ppText Text
t
    ppWord Lexeme Text
x                        = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> String
forall a. Show a => a -> String
groom Lexeme Text
x

ppCommentBody :: Show a => [Node a (Lexeme Text)] -> Doc
ppCommentBody :: [Node a (Lexeme Text)] -> Doc
ppCommentBody = [Lexeme Text] -> Doc
ppCommentWords ([Lexeme Text] -> Doc)
-> ([Node a (Lexeme Text)] -> [Lexeme Text])
-> [Node a (Lexeme Text)]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node a (Lexeme Text) -> Lexeme Text)
-> [Node a (Lexeme Text)] -> [Lexeme Text]
forall a b. (a -> b) -> [a] -> [b]
map Node a (Lexeme Text) -> Lexeme Text
forall a p. (Show a, Show p) => Node a p -> p
unCommentWord
  where
    unCommentWord :: Node a p -> p
unCommentWord (CommentWord p
l) = p
l
    unCommentWord Node a p
x               = String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ Node a p -> String
forall a. Show a => a -> String
groom Node a p
x

ppScope :: Scope -> Doc
ppScope :: Scope -> Doc
ppScope Scope
Global = Doc
empty
ppScope Scope
Static = String -> Doc
text String
"static "

ppType :: Show a => Node a (Lexeme Text) -> Doc
ppType :: Node a (Lexeme Text) -> Doc
ppType (TyPointer     Node a (Lexeme Text)
ty) = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'*'
ppType (TyConst       Node a (Lexeme Text)
ty) = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> String -> Doc
text String
"const"
ppType (TyUserDefined Lexeme Text
l ) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppType (TyStd         Lexeme Text
l ) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppType (TyFunc        Lexeme Text
l ) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppType (TyStruct      Lexeme Text
l ) = String -> Doc
text String
"struct" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppType (TyVar         Lexeme Text
l ) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppType Node a (Lexeme Text)
x                  = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc)
-> (Node a (Lexeme Text) -> String) -> Node a (Lexeme Text) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom (Node a (Lexeme Text) -> Doc) -> Node a (Lexeme Text) -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text)
x

ppAssignOp :: AssignOp -> Doc
ppAssignOp :: AssignOp -> Doc
ppAssignOp AssignOp
op = case AssignOp
op of
    AssignOp
AopEq     -> String -> Doc
text String
"="
    AssignOp
AopMul    -> String -> Doc
text String
"*="
    AssignOp
AopDiv    -> String -> Doc
text String
"/="
    AssignOp
AopPlus   -> String -> Doc
text String
"+="
    AssignOp
AopMinus  -> String -> Doc
text String
"-="
    AssignOp
AopBitAnd -> String -> Doc
text String
"&="
    AssignOp
AopBitOr  -> String -> Doc
text String
"|="
    AssignOp
AopBitXor -> String -> Doc
text String
"^="
    AssignOp
AopMod    -> String -> Doc
text String
"%="
    AssignOp
AopLsh    -> String -> Doc
text String
">>="
    AssignOp
AopRsh    -> String -> Doc
text String
"<<="

ppBinaryOp :: BinaryOp -> Doc
ppBinaryOp :: BinaryOp -> Doc
ppBinaryOp BinaryOp
op = case BinaryOp
op of
    BinaryOp
BopNe     -> String -> Doc
text String
"!="
    BinaryOp
BopEq     -> String -> Doc
text String
"=="
    BinaryOp
BopOr     -> String -> Doc
text String
"||"
    BinaryOp
BopBitXor -> Char -> Doc
char Char
'^'
    BinaryOp
BopBitOr  -> Char -> Doc
char Char
'|'
    BinaryOp
BopAnd    -> String -> Doc
text String
"&&"
    BinaryOp
BopBitAnd -> Char -> Doc
char Char
'&'
    BinaryOp
BopDiv    -> Char -> Doc
char Char
'/'
    BinaryOp
BopMul    -> Char -> Doc
char Char
'*'
    BinaryOp
BopMod    -> Char -> Doc
char Char
'%'
    BinaryOp
BopPlus   -> Char -> Doc
char Char
'+'
    BinaryOp
BopMinus  -> Char -> Doc
char Char
'-'
    BinaryOp
BopLt     -> Char -> Doc
char Char
'<'
    BinaryOp
BopLe     -> String -> Doc
text String
"<="
    BinaryOp
BopLsh    -> String -> Doc
text String
"<<"
    BinaryOp
BopGt     -> Char -> Doc
char Char
'>'
    BinaryOp
BopGe     -> String -> Doc
text String
">="
    BinaryOp
BopRsh    -> String -> Doc
text String
">>"

ppUnaryOp :: UnaryOp -> Doc
ppUnaryOp :: UnaryOp -> Doc
ppUnaryOp UnaryOp
op = case UnaryOp
op of
    UnaryOp
UopNot     -> Char -> Doc
char Char
'!'
    UnaryOp
UopNeg     -> Char -> Doc
char Char
'~'
    UnaryOp
UopMinus   -> Char -> Doc
char Char
'-'
    UnaryOp
UopAddress -> Char -> Doc
char Char
'&'
    UnaryOp
UopDeref   -> Char -> Doc
char Char
'*'
    UnaryOp
UopIncr    -> String -> Doc
text String
"++"
    UnaryOp
UopDecr    -> String -> Doc
text String
"--"

ppInitialiserList :: Show a => [Node a (Lexeme Text)] -> Doc
ppInitialiserList :: [Node a (Lexeme Text)] -> Doc
ppInitialiserList [Node a (Lexeme Text)]
l = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<+> (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppCommaSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr [Node a (Lexeme Text)]
l Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'}'

ppDeclSpec :: Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec :: Node a (Lexeme Text) -> Doc
ppDeclSpec (DeclSpecVar Lexeme Text
var        ) = Lexeme Text -> Doc
ppLexeme Lexeme Text
var
ppDeclSpec (DeclSpecArray Node a (Lexeme Text)
dspec Maybe (Node a (Lexeme Text))
dim) = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Node a (Lexeme Text)) -> Doc
forall a. Show a => Maybe (Node a (Lexeme Text)) -> Doc
ppDim Maybe (Node a (Lexeme Text))
dim
  where
    ppDim :: Maybe (Node a (Lexeme Text)) -> Doc
ppDim Maybe (Node a (Lexeme Text))
Nothing  = String -> Doc
text String
"[]"
    ppDim (Just Node a (Lexeme Text)
x) = Char -> Doc
char Char
'[' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'
ppDeclSpec Node a (Lexeme Text)
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppDeclarator :: Show a => Node a (Lexeme Text) -> Doc
ppDeclarator :: Node a (Lexeme Text) -> Doc
ppDeclarator (Declarator Node a (Lexeme Text)
dspec Maybe (Node a (Lexeme Text))
Nothing) =
    Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec
ppDeclarator (Declarator Node a (Lexeme Text)
dspec (Just Node a (Lexeme Text)
initr)) =
    Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
initr
ppDeclarator Node a (Lexeme Text)
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppFunctionParamList :: Show a => [Node a (Lexeme Text)] -> Doc
ppFunctionParamList :: [Node a (Lexeme Text)] -> Doc
ppFunctionParamList [Node a (Lexeme Text)]
xs = Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppCommaSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
go [Node a (Lexeme Text)]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
  where
    go :: Node a (Lexeme Text) -> Doc
go (TyStd l :: Lexeme Text
l@(L AlexPosn
_ LexemeClass
KwVoid Text
_)) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    go (FunctionParam Node a (Lexeme Text)
ty Node a (Lexeme Text)
dspec) = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec
    go Node a (Lexeme Text)
Ellipsis                 = String -> Doc
text String
"..."
    go Node a (Lexeme Text)
x                        = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppFunctionPrototype
    :: Show a
    => Node a (Lexeme Text)
    -> Lexeme Text
    -> [Node a (Lexeme Text)]
    -> Doc
ppFunctionPrototype :: Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppFunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params =
    Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppFunctionParamList [Node a (Lexeme Text)]
params

ppWithError :: Show a => Maybe (Node a (Lexeme Text)) -> Doc
ppWithError :: Maybe (Node a (Lexeme Text)) -> Doc
ppWithError Maybe (Node a (Lexeme Text))
Nothing = Char -> Doc
char Char
';'
ppWithError (Just (ErrorFor Lexeme Text
name)) =
    String -> Doc
text String
" with error for" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
ppWithError (Just (ErrorList [Node a (Lexeme Text)]
errs)) =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
" with error" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
errs
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
ppWithError Maybe (Node a (Lexeme Text))
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe (Node a (Lexeme Text)) -> String
forall a. Show a => a -> String
groom Maybe (Node a (Lexeme Text))
x

ppFunctionCall :: Show a => Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppFunctionCall :: Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppFunctionCall Node a (Lexeme Text)
callee [Node a (Lexeme Text)]
args =
    Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
callee Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppCommaSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr [Node a (Lexeme Text)]
args Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppMacroBody :: Show a => Node a (Lexeme Text) -> Doc
ppMacroBody :: Node a (Lexeme Text) -> Doc
ppMacroBody (MacroBodyFunCall e :: Node a (Lexeme Text)
e@FunctionCall{}) = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e
ppMacroBody (MacroBodyStmt [Node a (Lexeme Text)]
body) =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"do {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"} while (0)"
ppMacroBody Node a (Lexeme Text)
x                                   = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppMacroParam :: Show a => Node a (Lexeme Text) -> Doc
ppMacroParam :: Node a (Lexeme Text) -> Doc
ppMacroParam (MacroParam Lexeme Text
l) = Lexeme Text -> Doc
ppLexeme Lexeme Text
l
ppMacroParam Node a (Lexeme Text)
Ellipsis       = String -> Doc
text String
"..."
ppMacroParam Node a (Lexeme Text)
x              = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppMacroParamList :: Show a => [Node a (Lexeme Text)] -> Doc
ppMacroParamList :: [Node a (Lexeme Text)] -> Doc
ppMacroParamList [Node a (Lexeme Text)]
xs = Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppCommaSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppMacroParam [Node a (Lexeme Text)]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppNamespace :: ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc
ppNamespace :: ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc
ppNamespace [a] -> Doc
pp Scope
scope Lexeme Text
name [a]
members =
    Int -> Doc -> Doc
nest Int
2 (
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        String -> Doc
text String
"namespace" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
        [a] -> Doc
pp [a]
members
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppEnumerator :: Show a => Node a (Lexeme Text) -> Doc
ppEnumerator :: Node a (Lexeme Text) -> Doc
ppEnumerator (Comment    CommentStyle
style Lexeme Text
_ [Node a (Lexeme Text)]
cs Lexeme Text
_ ) = CommentStyle -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment CommentStyle
style [Node a (Lexeme Text)]
cs
ppEnumerator (Enumerator Lexeme Text
name  Maybe (Node a (Lexeme Text))
Nothing) = Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
','
ppEnumerator (Enumerator Lexeme Text
name (Just Node a (Lexeme Text)
value)) =
    Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
','
ppEnumerator (Namespace Scope
scope Lexeme Text
name [Node a (Lexeme Text)]
members) =
    ([Node a (Lexeme Text)] -> Doc)
-> Scope -> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a. ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc
ppNamespace [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList Scope
scope Lexeme Text
name [Node a (Lexeme Text)]
members
ppEnumerator Node a (Lexeme Text)
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppEnumeratorList :: Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList :: [Node a (Lexeme Text)] -> Doc
ppEnumeratorList = (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppEnumerator

ppMemberDecl :: Show a => Node a (Lexeme Text) -> Doc
ppMemberDecl :: Node a (Lexeme Text) -> Doc
ppMemberDecl = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl

ppMemberDeclList :: Show a => [Node a (Lexeme Text)] -> Doc
ppMemberDeclList :: [Node a (Lexeme Text)] -> Doc
ppMemberDeclList = (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppMemberDecl

ppAccessor :: Show a => Node a (Lexeme Text) -> Doc
ppAccessor :: Node a (Lexeme Text) -> Doc
ppAccessor (Comment CommentStyle
style Lexeme Text
_ [Node a (Lexeme Text)]
cs Lexeme Text
_) = CommentStyle -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment CommentStyle
style [Node a (Lexeme Text)]
cs
ppAccessor (Accessor Lexeme Text
name [Node a (Lexeme Text)]
params Maybe (Node a (Lexeme Text))
errs) =
    Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppFunctionParamList [Node a (Lexeme Text)]
params Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Node a (Lexeme Text)) -> Doc
forall a. Show a => Maybe (Node a (Lexeme Text)) -> Doc
ppWithError Maybe (Node a (Lexeme Text))
errs
ppAccessor Node a (Lexeme Text)
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppAccessorList :: Show a => [Node a (Lexeme Text)] -> Doc
ppAccessorList :: [Node a (Lexeme Text)] -> Doc
ppAccessorList = (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppAccessor

ppEventType :: Show a => Node a (Lexeme Text) -> Doc
ppEventType :: Node a (Lexeme Text) -> Doc
ppEventType (Commented (Comment CommentStyle
style Lexeme Text
_ [Node a (Lexeme Text)]
cs Lexeme Text
_) Node a (Lexeme Text)
ty) =
    CommentStyle -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment CommentStyle
style [Node a (Lexeme Text)]
cs Doc -> Doc -> Doc
<$> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppEventType Node a (Lexeme Text)
ty
ppEventType (EventParams [Node a (Lexeme Text)]
params) =
    String -> Doc
text String
"typedef void" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppFunctionParamList [Node a (Lexeme Text)]
params
ppEventType Node a (Lexeme Text)
x = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppTypeParams :: Show a => [Node a (Lexeme Text)] -> Doc
ppTypeParams :: [Node a (Lexeme Text)] -> Doc
ppTypeParams [] = Doc
empty
ppTypeParams [Node a (Lexeme Text)]
xs = Char -> Doc
char Char
'<' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppCommaSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
pp [Node a (Lexeme Text)]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'>'
  where
    pp :: Node a (Lexeme Text) -> Doc
pp (TyVar Lexeme Text
x) = Lexeme Text -> Doc
ppLexeme Lexeme Text
x
    pp Node a (Lexeme Text)
x         = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppCompoundStmt :: Show a => [Node a (Lexeme Text)] -> Doc
ppCompoundStmt :: [Node a (Lexeme Text)] -> Doc
ppCompoundStmt [Node a (Lexeme Text)]
body =
    Int -> Doc -> Doc
nest Int
2 (
        Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppStmtList :: Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList :: [Node a (Lexeme Text)] -> Doc
ppStmtList = (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl

ppIfStmt
    :: Show a
    => Node a (Lexeme Text)
    -> [Node a (Lexeme Text)]
    -> Maybe (Node a (Lexeme Text))
    -> Doc
ppIfStmt :: Node a (Lexeme Text)
-> [Node a (Lexeme Text)] -> Maybe (Node a (Lexeme Text)) -> Doc
ppIfStmt Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
t Maybe (Node a (Lexeme Text))
Nothing =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"if (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
t
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
ppIfStmt Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
t (Just Node a (Lexeme Text)
e) =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"if (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
t
    ) Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
nest Int
2 (Char -> Doc
char Char
'}' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" else " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
e)

ppForStmt
    :: Show a
    => Node a (Lexeme Text)
    -> Node a (Lexeme Text)
    -> Node a (Lexeme Text)
    -> [Node a (Lexeme Text)]
    -> Doc
ppForStmt :: Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> [Node a (Lexeme Text)]
-> Doc
ppForStmt Node a (Lexeme Text)
i Node a (Lexeme Text)
c Node a (Lexeme Text)
n [Node a (Lexeme Text)]
body =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"for ("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
i
        Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
        Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
n
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppWhileStmt
    :: Show a
    => Node a (Lexeme Text)
    -> [Node a (Lexeme Text)]
    -> Doc
ppWhileStmt :: Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppWhileStmt Node a (Lexeme Text)
c [Node a (Lexeme Text)]
body =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"while ("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
c
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppDoWhileStmt
    :: Show a
    => [Node a (Lexeme Text)]
    -> Node a (Lexeme Text)
    -> Doc
ppDoWhileStmt :: [Node a (Lexeme Text)] -> Node a (Lexeme Text) -> Doc
ppDoWhileStmt [Node a (Lexeme Text)]
body Node a (Lexeme Text)
c =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"do ("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"} while (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppSwitchStmt
    :: Show a
    => Node a (Lexeme Text)
    -> [Node a (Lexeme Text)]
    -> Doc
ppSwitchStmt :: Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppSwitchStmt Node a (Lexeme Text)
c [Node a (Lexeme Text)]
body =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"switch ("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
c
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppExpr :: Show a => Node a (Lexeme Text) -> Doc
ppExpr :: Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
expr = case Node a (Lexeme Text)
expr of
    -- Expressions
    VarExpr Lexeme Text
var       -> Lexeme Text -> Doc
ppLexeme Lexeme Text
var
    LiteralExpr LiteralType
_ Lexeme Text
l   -> Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    SizeofExpr Node a (Lexeme Text)
arg    -> String -> Doc
text String
"sizeof(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
arg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    SizeofType Node a (Lexeme Text)
arg    -> String -> Doc
text String
"sizeof(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
arg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    BinaryExpr  Node a (Lexeme Text)
l BinaryOp
o Node a (Lexeme Text)
r -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
l Doc -> Doc -> Doc
<+> BinaryOp -> Doc
ppBinaryOp BinaryOp
o Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
r
    AssignExpr  Node a (Lexeme Text)
l AssignOp
o Node a (Lexeme Text)
r -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
l Doc -> Doc -> Doc
<+> AssignOp -> Doc
ppAssignOp AssignOp
o Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
r
    TernaryExpr Node a (Lexeme Text)
c Node a (Lexeme Text)
t Node a (Lexeme Text)
e -> Node a (Lexeme Text)
-> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppTernaryExpr Node a (Lexeme Text)
c Node a (Lexeme Text)
t Node a (Lexeme Text)
e
    UnaryExpr UnaryOp
o Node a (Lexeme Text)
e     -> UnaryOp -> Doc
ppUnaryOp UnaryOp
o Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e
    ParenExpr Node a (Lexeme Text)
e       -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    FunctionCall Node a (Lexeme Text)
c  [Node a (Lexeme Text)]
a -> Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppFunctionCall Node a (Lexeme Text)
c [Node a (Lexeme Text)]
a
    ArrayAccess  Node a (Lexeme Text)
e  Node a (Lexeme Text)
i -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'[' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'
    CastExpr     Node a (Lexeme Text)
ty Node a (Lexeme Text)
e -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e
    CompoundExpr Node a (Lexeme Text)
ty Node a (Lexeme Text)
e -> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')' Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'}'
    PreprocDefined  Lexeme Text
n -> String -> Doc
text String
"defined(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    InitialiserList [Node a (Lexeme Text)]
l -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppInitialiserList [Node a (Lexeme Text)]
l
    PointerAccess Node a (Lexeme Text)
e Lexeme Text
m -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"->" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
m
    MemberAccess  Node a (Lexeme Text)
e Lexeme Text
m -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
m
    CommentExpr   Node a (Lexeme Text)
c Node a (Lexeme Text)
e -> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
forall a.
Show a =>
Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppCommentExpr Node a (Lexeme Text)
c Node a (Lexeme Text)
e
    LicenseDecl Lexeme Text
l [Node a (Lexeme Text)]
cs  -> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppLicenseDecl Lexeme Text
l [Node a (Lexeme Text)]
cs

    Node a (Lexeme Text)
x                 -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppTernaryExpr
    :: Show a => Node a (Lexeme Text) -> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppTernaryExpr :: Node a (Lexeme Text)
-> Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppTernaryExpr Node a (Lexeme Text)
c Node a (Lexeme Text)
t Node a (Lexeme Text)
e =
    Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
c Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
t Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e

ppLicenseDecl :: Show a => Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppLicenseDecl :: Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppLicenseDecl Lexeme Text
l [Node a (Lexeme Text)]
cs =
    CommentStyle -> Doc
ppCommentStyle CommentStyle
Regular Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
<$>
    (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppCopyrightDecl [Node a (Lexeme Text)]
cs

ppCopyrightDecl :: Show a => Node a (Lexeme Text) -> Doc
ppCopyrightDecl :: Node a (Lexeme Text) -> Doc
ppCopyrightDecl (CopyrightDecl Lexeme Text
from (Just Lexeme Text
to) [Lexeme Text]
owner) =
    Lexeme Text -> Doc
ppLexeme Lexeme Text
from Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
to Doc -> Doc -> Doc
<+>
    [Lexeme Text] -> Doc
ppCommentWords [Lexeme Text]
owner
ppCopyrightDecl (CopyrightDecl Lexeme Text
from Maybe (Lexeme Text)
Nothing [Lexeme Text]
owner) =
    Lexeme Text -> Doc
ppLexeme Lexeme Text
from Doc -> Doc -> Doc
<+>
    [Lexeme Text] -> Doc
ppCommentWords [Lexeme Text]
owner
ppCopyrightDecl Node a (Lexeme Text)
x =
    String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
x

ppCommentExpr :: Show a => Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppCommentExpr :: Node a (Lexeme Text) -> Node a (Lexeme Text) -> Doc
ppCommentExpr (Comment CommentStyle
style Lexeme Text
_ [Node a (Lexeme Text)]
body Lexeme Text
_) Node a (Lexeme Text)
e =
    CommentStyle -> Doc
ppCommentStyle CommentStyle
style Doc -> Doc -> Doc
<+> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppCommentBody [Node a (Lexeme Text)]
body Doc -> Doc -> Doc
<+> String -> Doc
text String
"*/" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e
ppCommentExpr Node a (Lexeme Text)
c Node a (Lexeme Text)
_ = String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Node a (Lexeme Text) -> String
forall a. Show a => a -> String
groom Node a (Lexeme Text)
c

ppStmt :: Show a => Node a (Lexeme Text) -> Doc
ppStmt :: Node a (Lexeme Text) -> Doc
ppStmt = Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl

ppDeclList :: Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList :: [Node a (Lexeme Text)] -> Doc
ppDeclList = (Node a (Lexeme Text) -> Doc) -> [Node a (Lexeme Text)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppLineSep Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl

ppDecl :: Show a => Node a (Lexeme Text) -> Doc
ppDecl :: Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
decl = case Node a (Lexeme Text)
decl of
    PreprocElif Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
decls (PreprocElse []) ->
        String -> Doc
text String
"#elif" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocElif Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
decls Node a (Lexeme Text)
elseBranch ->
        String -> Doc
text String
"#elif" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)
elseBranch] Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIf Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
decls (PreprocElse []) ->
        Int -> Doc -> Doc
nest (-Int
100) (String -> Doc
text String
"#if") Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIf Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
decls Node a (Lexeme Text)
elseBranch ->
        String -> Doc
text String
"#if" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)
elseBranch] Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfdef Lexeme Text
name [Node a (Lexeme Text)]
decls (PreprocElse []) ->
        Int -> Doc -> Doc
indent (-Int
2) (String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls) Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfdef Lexeme Text
name [Node a (Lexeme Text)]
decls Node a (Lexeme Text)
elseBranch ->
        String -> Doc
text String
"#ifdef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)
elseBranch] Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfndef Lexeme Text
name [Node a (Lexeme Text)]
decls (PreprocElse []) ->
        String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfndef Lexeme Text
name [Node a (Lexeme Text)]
decls Node a (Lexeme Text)
elseBranch ->
        String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)
elseBranch] Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocElse [Node a (Lexeme Text)]
decls ->
        String -> Doc
text String
"#else" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls

    PreprocScopedDefine Node a (Lexeme Text)
def [Node a (Lexeme Text)]
stmts Node a (Lexeme Text)
undef ->
        Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
def Doc -> Doc -> Doc
<$> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
stmts Doc -> Doc -> Doc
<$> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
undef

    PreprocInclude Lexeme Text
hdr ->
        String -> Doc
text String
"#include" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
hdr
    PreprocDefine Lexeme Text
name ->
        String -> Doc
text String
"#define" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name
    PreprocDefineConst Lexeme Text
name Node a (Lexeme Text)
value ->
        String -> Doc
text String
"#define" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
value
    PreprocDefineMacro Lexeme Text
name [Node a (Lexeme Text)]
params Node a (Lexeme Text)
body ->
        String -> Doc
text String
"#define" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppMacroParamList [Node a (Lexeme Text)]
params Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppMacroBody Node a (Lexeme Text)
body
    PreprocUndef Lexeme Text
name ->
        String -> Doc
text String
"#undef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name

    StaticAssert Node a (Lexeme Text)
cond Lexeme Text
msg ->
        String -> Doc
text String
"static_assert" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
',' Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
msg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
");"

    Comment CommentStyle
style Lexeme Text
_ [Node a (Lexeme Text)]
cs Lexeme Text
_ ->
        CommentStyle -> [Node a (Lexeme Text)] -> Doc
forall a. Show a => CommentStyle -> [Node a (Lexeme Text)] -> Doc
ppComment CommentStyle
style [Node a (Lexeme Text)]
cs
    CommentBlock Lexeme Text
cs ->
        Lexeme Text -> Doc
ppLexeme Lexeme Text
cs
    Commented Node a (Lexeme Text)
c Node a (Lexeme Text)
d ->
        Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
c Doc -> Doc -> Doc
<$> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDecl Node a (Lexeme Text)
d

    ClassForward Lexeme Text
name [] ->
        String -> Doc
text String
"class" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Class Scope
scope Lexeme Text
name [Node a (Lexeme Text)]
tyvars [Node a (Lexeme Text)]
decls ->
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"class" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppTypeParams [Node a (Lexeme Text)]
tyvars Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"

    EnumConsts Maybe (Lexeme Text)
Nothing [Node a (Lexeme Text)]
enums ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
enums
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
    EnumConsts (Just Lexeme Text
name) [Node a (Lexeme Text)]
enums ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
enums
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
    EnumClass Lexeme Text
name [Node a (Lexeme Text)]
enums ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"enum class" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
enums
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
    EnumDecl Lexeme Text
name [Node a (Lexeme Text)]
enums Lexeme Text
ty ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"typedef enum" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
enums
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"} " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'

    Namespace Scope
scope Lexeme Text
name [Node a (Lexeme Text)]
decls ->
        ([Node a (Lexeme Text)] -> Doc)
-> Scope -> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a. ([a] -> Doc) -> Scope -> Lexeme Text -> [a] -> Doc
ppNamespace [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList Scope
scope Lexeme Text
name [Node a (Lexeme Text)]
decls

    ExternC [Node a (Lexeme Text)]
decls ->
        String -> Doc
text String
"#ifndef __cplusplus" Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"extern \"C\" {" Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif" Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#ifndef __cplusplus" Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"}" Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"

    Struct Lexeme Text
name [Node a (Lexeme Text)]
members ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"struct" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppMemberDeclList [Node a (Lexeme Text)]
members
        ) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
    Typedef (Union Lexeme Text
name [Node a (Lexeme Text)]
members) Lexeme Text
tyname ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"typedef union" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppMemberDeclList [Node a (Lexeme Text)]
members
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}' Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
tyname Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Typedef (Struct Lexeme Text
name [Node a (Lexeme Text)]
members) Lexeme Text
tyname ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"typedef struct" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppMemberDeclList [Node a (Lexeme Text)]
members
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}' Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
tyname Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Typedef Node a (Lexeme Text)
ty Lexeme Text
name ->
        String -> Doc
text String
"typedef" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    TypedefFunction (FunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params) ->
        String -> Doc
text String
"typedef" Doc -> Doc -> Doc
<+>
        Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppFunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Char -> Doc
char Char
';'

    MemberDecl Node a (Lexeme Text)
ty Node a (Lexeme Text)
dspec Maybe (Lexeme Text)
Nothing ->
        Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    MemberDecl Node a (Lexeme Text)
ty Node a (Lexeme Text)
dspec (Just Lexeme Text
size) ->
        Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
size Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'

    FunctionDecl Scope
scope (FunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params) Maybe (Node a (Lexeme Text))
err ->
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppFunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Maybe (Node a (Lexeme Text)) -> Doc
forall a. Show a => Maybe (Node a (Lexeme Text)) -> Doc
ppWithError Maybe (Node a (Lexeme Text))
err
    FunctionDefn Scope
scope (FunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params) [Node a (Lexeme Text)]
body ->
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> Lexeme Text -> [Node a (Lexeme Text)] -> Doc
ppFunctionPrototype Node a (Lexeme Text)
ty Lexeme Text
name [Node a (Lexeme Text)]
params Doc -> Doc -> Doc
<$>
        [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppCompoundStmt [Node a (Lexeme Text)]
body

    ConstDecl Node a (Lexeme Text)
ty Lexeme Text
name ->
        String -> Doc
text String
"extern const" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    ConstDefn Scope
scope Node a (Lexeme Text)
ty Lexeme Text
name Node a (Lexeme Text)
value ->
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'

    Event Lexeme Text
name Node a (Lexeme Text)
ty ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"event" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppEventType Node a (Lexeme Text)
ty
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

    Property Node a (Lexeme Text)
ty Node a (Lexeme Text)
dspec [Node a (Lexeme Text)]
accessors ->
        Int -> Doc -> Doc
nest Int
2 (
            Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclSpec Node a (Lexeme Text)
dspec Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppAccessorList [Node a (Lexeme Text)]
accessors
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

    ErrorDecl Lexeme Text
name [Node a (Lexeme Text)]
errs ->
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"error for" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppEnumeratorList [Node a (Lexeme Text)]
errs
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

    -- Statements
    Node a (Lexeme Text)
Continue              -> String -> Doc
text String
"continue;"
    Node a (Lexeme Text)
Break                 -> String -> Doc
text String
"break;"
    Return Maybe (Node a (Lexeme Text))
Nothing        -> String -> Doc
text String
"return;"
    Return (Just Node a (Lexeme Text)
e)       -> String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    VarDecl Node a (Lexeme Text)
ty Node a (Lexeme Text)
declr      -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppDeclarator Node a (Lexeme Text)
declr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    IfStmt Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
t Maybe (Node a (Lexeme Text))
e       -> Node a (Lexeme Text)
-> [Node a (Lexeme Text)] -> Maybe (Node a (Lexeme Text)) -> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> [Node a (Lexeme Text)] -> Maybe (Node a (Lexeme Text)) -> Doc
ppIfStmt Node a (Lexeme Text)
cond [Node a (Lexeme Text)]
t Maybe (Node a (Lexeme Text))
e
    ForStmt Node a (Lexeme Text)
i Node a (Lexeme Text)
c Node a (Lexeme Text)
n [Node a (Lexeme Text)]
body    -> Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> [Node a (Lexeme Text)]
-> Doc
forall a.
Show a =>
Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> Node a (Lexeme Text)
-> [Node a (Lexeme Text)]
-> Doc
ppForStmt Node a (Lexeme Text)
i Node a (Lexeme Text)
c Node a (Lexeme Text)
n [Node a (Lexeme Text)]
body
    Default Node a (Lexeme Text)
s             -> String -> Doc
text String
"default:" Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppStmt Node a (Lexeme Text)
s
    Label Lexeme Text
l Node a (Lexeme Text)
s             -> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<$> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppStmt Node a (Lexeme Text)
s
    Goto Lexeme Text
l                -> String -> Doc
text String
"goto " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Case        Node a (Lexeme Text)
e    Node a (Lexeme Text)
s    -> String -> Doc
text String
"case " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppStmt Node a (Lexeme Text)
s
    WhileStmt   Node a (Lexeme Text)
c    [Node a (Lexeme Text)]
body -> Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppWhileStmt Node a (Lexeme Text)
c [Node a (Lexeme Text)]
body
    DoWhileStmt [Node a (Lexeme Text)]
body Node a (Lexeme Text)
c    -> [Node a (Lexeme Text)] -> Node a (Lexeme Text) -> Doc
forall a.
Show a =>
[Node a (Lexeme Text)] -> Node a (Lexeme Text) -> Doc
ppDoWhileStmt [Node a (Lexeme Text)]
body Node a (Lexeme Text)
c
    SwitchStmt  Node a (Lexeme Text)
c    [Node a (Lexeme Text)]
body -> Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
forall a.
Show a =>
Node a (Lexeme Text) -> [Node a (Lexeme Text)] -> Doc
ppSwitchStmt Node a (Lexeme Text)
c [Node a (Lexeme Text)]
body
    CompoundStmt [Node a (Lexeme Text)]
body     -> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$> [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppStmtList [Node a (Lexeme Text)]
body Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
    VLA Node a (Lexeme Text)
ty Lexeme Text
n Node a (Lexeme Text)
sz           -> Node a (Lexeme Text) -> Lexeme Text -> Node a (Lexeme Text) -> Doc
forall a.
Show a =>
Node a (Lexeme Text) -> Lexeme Text -> Node a (Lexeme Text) -> Doc
ppVLA Node a (Lexeme Text)
ty Lexeme Text
n Node a (Lexeme Text)
sz

    Node a (Lexeme Text)
x                     -> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'


ppVLA :: Show a => Node a (Lexeme Text) -> Lexeme Text -> Node a (Lexeme Text) -> Doc
ppVLA :: Node a (Lexeme Text) -> Lexeme Text -> Node a (Lexeme Text) -> Doc
ppVLA Node a (Lexeme Text)
ty Lexeme Text
n Node a (Lexeme Text)
sz =
    String -> Doc
text String
"VLA("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppType Node a (Lexeme Text)
ty
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", "
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
n
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", "
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Node a (Lexeme Text) -> Doc
forall a. Show a => Node a (Lexeme Text) -> Doc
ppExpr Node a (Lexeme Text)
sz
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
");"

ppTranslationUnit :: Show a => [Node a (Lexeme Text)] -> Doc
ppTranslationUnit :: [Node a (Lexeme Text)] -> Doc
ppTranslationUnit [Node a (Lexeme Text)]
decls = [Node a (Lexeme Text)] -> Doc
forall a. Show a => [Node a (Lexeme Text)] -> Doc
ppDeclList [Node a (Lexeme Text)]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak