{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Language.Cimple.Pretty (plain, ppTranslationUnit, showNode) where
import Data.Fix (foldFix)
import qualified Data.List.Split as List
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Cimple (AssignOp (..), BinaryOp (..),
CommentStyle (..), Lexeme (..),
LexemeClass (..), Node,
NodeF (..), Scope (..),
UnaryOp (..), lexemeText)
import Prelude hiding ((<$>))
import Text.PrettyPrint.ANSI.Leijen
kwBreak :: Doc
kwBreak = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"break"
kwCase :: Doc
kwCase = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"case"
kwConst :: Doc
kwConst = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"const"
kwContinue :: Doc
kwContinue = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"continue"
kwDefault :: Doc
kwDefault = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"default"
kwDo :: Doc
kwDo = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"do"
kwElse :: Doc
kwElse = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"else"
kwEnum :: Doc
kwEnum = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"enum"
kwExtern :: Doc
kwExtern = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"extern"
kwFor :: Doc
kwFor = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"for"
kwGoto :: Doc
kwGoto = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"goto"
kwIf :: Doc
kwIf = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"if"
kwNullable :: Doc
kwNullable = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"nullable"
kwNonNull :: Doc
kwNonNull = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"non_null"
kwReturn :: Doc
kwReturn = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return"
kwSizeof :: Doc
kwSizeof = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof"
kwStaticAssert :: Doc
kwStaticAssert = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"static_assert"
kwStatic :: Doc
kwStatic = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"static"
kwStruct :: Doc
kwStruct = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"struct"
kwSwitch :: Doc
kwSwitch = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"switch"
kwTypedef :: Doc
kwTypedef = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"typedef"
kwUnion :: Doc
kwUnion = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"union"
kwWhile :: Doc
kwWhile = Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"while"
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
commaSep :: [Doc] -> Doc
commaSep :: [Doc] -> Doc
commaSep = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
ppScope :: Scope -> Doc
ppScope :: Scope -> Doc
ppScope = \case
Scope
Global -> Doc
empty
Scope
Static -> Doc
kwStatic Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space
ppAssignOp :: AssignOp -> Doc
ppAssignOp :: AssignOp -> Doc
ppAssignOp = \case
AssignOp
AopEq -> Doc
equals
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 = \case
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 = \case
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
"--"
ppCommentStyle :: CommentStyle -> Doc
= Doc -> Doc
dullyellow (Doc -> Doc) -> (CommentStyle -> Doc) -> CommentStyle -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
CommentStyle
Block -> String -> Doc
text String
"/***"
CommentStyle
Doxygen -> String -> Doc
text String
"/**"
CommentStyle
Regular -> String -> Doc
text String
"/*"
ppCommentBody :: [Lexeme Text] -> Doc
ppCommentBody :: [Lexeme Text] -> Doc
ppCommentBody = [Doc] -> Doc
vsep ([Doc] -> Doc) -> ([Lexeme Text] -> [Doc]) -> [Lexeme Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Lexeme Text] -> Doc) -> [[Lexeme Text]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Lexeme Text] -> [Doc]) -> [Lexeme Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme Text -> Doc) -> [Lexeme Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme Text -> Doc
ppWord) ([[Lexeme Text]] -> [Doc])
-> ([Lexeme Text] -> [[Lexeme Text]]) -> [Lexeme Text] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme Text] -> [[Lexeme Text]]
forall {text}. [Lexeme text] -> [[Lexeme text]]
groupLines
where
groupLines :: [Lexeme text] -> [[Lexeme text]]
groupLines = (Lexeme text -> Bool) -> [Lexeme text] -> [[Lexeme text]]
forall a. (a -> Bool) -> [a] -> [[a]]
List.splitWhen ((Lexeme text -> Bool) -> [Lexeme text] -> [[Lexeme text]])
-> (Lexeme text -> Bool) -> [Lexeme text] -> [[Lexeme text]]
forall a b. (a -> b) -> a -> b
$ \case
L AlexPosn
_ LexemeClass
PpNewline text
_ -> Bool
True
Lexeme text
_ -> Bool
False
ppWord :: Lexeme Text -> Doc
ppWord (L AlexPosn
_ LexemeClass
CmtIndent Text
_) = Doc -> Doc
dullyellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'*'
ppWord (L AlexPosn
_ LexemeClass
CmtCommand Text
t) = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
ppText Text
t
ppWord (L AlexPosn
_ LexemeClass
_ Text
t) = Doc -> Doc
dullyellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
ppText Text
t
ppComment :: CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc
CommentStyle
style [Lexeme Text]
cs (L AlexPosn
l LexemeClass
c Text
_) =
Int -> Doc -> Doc
nest Int
1 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CommentStyle -> Doc
ppCommentStyle CommentStyle
style Doc -> Doc -> Doc
<+> [Lexeme Text] -> Doc
ppCommentBody ([Lexeme Text]
cs [Lexeme Text] -> [Lexeme Text] -> [Lexeme Text]
forall a. [a] -> [a] -> [a]
++ [AlexPosn -> LexemeClass -> Text -> Lexeme Text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
l LexemeClass
c Text
"*/"])
ppInitialiserList :: [Doc] -> Doc
ppInitialiserList :: [Doc] -> Doc
ppInitialiserList [Doc]
l = Doc
lbrace Doc -> Doc -> Doc
<+> [Doc] -> Doc
commaSep [Doc]
l Doc -> Doc -> Doc
<+> Doc
rbrace
ppParamList :: [Doc] -> Doc
ppParamList :: [Doc] -> Doc
ppParamList = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commaSep
ppFunctionPrototype
:: Doc
-> Lexeme Text
-> [Doc]
-> Doc
ppFunctionPrototype :: Doc -> Lexeme Text -> [Doc] -> Doc
ppFunctionPrototype Doc
ty Lexeme Text
name [Doc]
params =
Doc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
ppParamList [Doc]
params
ppFunctionCall :: Doc -> [Doc] -> Doc
ppFunctionCall :: Doc -> [Doc] -> Doc
ppFunctionCall Doc
callee [Doc]
args =
Doc
callee Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
ppParamList [Doc]
args
ppIfStmt
:: Doc
-> Doc
-> Maybe Doc
-> Doc
ppIfStmt :: Doc -> Doc -> Maybe Doc -> Doc
ppIfStmt Doc
cond Doc
t Maybe Doc
Nothing =
Doc
kwIf Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
cond Doc -> Doc -> Doc
<+> Doc
t
ppIfStmt Doc
cond Doc
t (Just Doc
e) =
Doc
kwIf Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
cond Doc -> Doc -> Doc
<+> Doc
t Doc -> Doc -> Doc
<+> Doc
kwElse Doc -> Doc -> Doc
<+> Doc
e
ppForStmt
:: Doc
-> Doc
-> Doc
-> Doc
-> Doc
ppForStmt :: Doc -> Doc -> Doc -> Doc -> Doc
ppForStmt Doc
i Doc
c Doc
n Doc
body =
Doc
kwFor Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Doc
i Doc -> Doc -> Doc
<+> Doc
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
<+> Doc
n) Doc -> Doc -> Doc
<+> Doc
body
ppWhileStmt
:: Doc
-> Doc
-> Doc
ppWhileStmt :: Doc -> Doc -> Doc
ppWhileStmt Doc
c Doc
body =
Doc
kwWhile Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
c Doc -> Doc -> Doc
<+> Doc
body
ppDoWhileStmt
:: Doc
-> Doc
-> Doc
ppDoWhileStmt :: Doc -> Doc -> Doc
ppDoWhileStmt Doc
body Doc
c =
Doc
kwDo Doc -> Doc -> Doc
<+> Doc
body Doc -> Doc -> Doc
<+> Doc
kwWhile Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ppSwitchStmt
:: Doc
-> [Doc]
-> Doc
ppSwitchStmt :: Doc -> [Doc] -> Doc
ppSwitchStmt Doc
c [Doc]
body =
Int -> Doc -> Doc
nest Int
2 (
Doc
kwSwitch Doc -> Doc -> Doc
<+> Doc -> Doc
parens Doc
c Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
body
) Doc -> Doc -> Doc
<$> Doc
rbrace
ppVLA :: Doc -> Lexeme Text -> Doc -> Doc
ppVLA :: Doc -> Lexeme Text -> Doc -> Doc
ppVLA Doc
ty Lexeme Text
n Doc
sz =
String -> Doc
text String
"VLA("
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
<> Doc
sz
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
");"
ppCompoundStmt :: [Doc] -> Doc
ppCompoundStmt :: [Doc] -> Doc
ppCompoundStmt [Doc]
body =
Int -> Doc -> Doc
nest Int
2 (
Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
body
) Doc -> Doc -> Doc
<$> Doc
rbrace
ppTernaryExpr
:: Doc
-> Doc
-> Doc
-> Doc
ppTernaryExpr :: Doc -> Doc -> Doc -> Doc
ppTernaryExpr Doc
c Doc
t Doc
e =
Doc
c Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> Doc
t Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Doc
e
ppLicenseDecl :: Lexeme Text -> [Doc] -> Doc
ppLicenseDecl :: Lexeme Text -> [Doc] -> Doc
ppLicenseDecl Lexeme Text
l [Doc]
cs =
Doc -> Doc
dullyellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ CommentStyle -> Doc
ppCommentStyle CommentStyle
Regular Doc -> Doc -> Doc
<+> String -> Doc
text String
"SPDX-License-Identifier: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
dullyellow [Doc]
cs) Doc -> Doc -> Doc
<$>
Doc -> Doc
dullyellow (String -> Doc
text String
" */")
ppIntList :: [Lexeme Text] -> Doc
ppIntList :: [Lexeme Text] -> Doc
ppIntList = Doc -> Doc
parens (Doc -> Doc) -> ([Lexeme Text] -> Doc) -> [Lexeme Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commaSep ([Doc] -> Doc) -> ([Lexeme Text] -> [Doc]) -> [Lexeme Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme Text -> Doc) -> [Lexeme Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
dullred (Doc -> Doc) -> (Lexeme Text -> Doc) -> Lexeme Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Doc
ppLexeme)
ppNode :: Node (Lexeme Text) -> Doc
ppNode :: Node (Lexeme Text) -> Doc
ppNode = (NodeF (Lexeme Text) Doc -> Doc) -> Node (Lexeme Text) -> Doc
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme Text) Doc -> Doc
go
where
go :: NodeF (Lexeme Text) Doc -> Doc
go :: NodeF (Lexeme Text) Doc -> Doc
go = \case
StaticAssert Doc
cond Lexeme Text
msg ->
Doc
kwStaticAssert Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> Doc -> Doc
dullred (Lexeme Text -> Doc
ppLexeme Lexeme Text
msg)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
LicenseDecl Lexeme Text
l [Doc]
cs -> Lexeme Text -> [Doc] -> Doc
ppLicenseDecl Lexeme Text
l [Doc]
cs
CopyrightDecl Lexeme Text
from (Just Lexeme Text
to) [Lexeme Text]
owner ->
String -> Doc
text String
" * Copyright © " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> 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
ppCommentBody [Lexeme Text]
owner
CopyrightDecl Lexeme Text
from Maybe (Lexeme Text)
Nothing [Lexeme Text]
owner ->
String -> Doc
text String
" * Copyright © " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
from Doc -> Doc -> Doc
<+>
[Lexeme Text] -> Doc
ppCommentBody [Lexeme Text]
owner
Comment CommentStyle
style Lexeme Text
_ [Lexeme Text]
cs Lexeme Text
e ->
CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc
ppComment CommentStyle
style [Lexeme Text]
cs Lexeme Text
e
CommentSectionEnd Lexeme Text
cs ->
Doc -> Doc
dullyellow (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
cs
Commented Doc
c Doc
d ->
Doc
c Doc -> Doc -> Doc
<$> Doc
d
VarExpr Lexeme Text
var -> Lexeme Text -> Doc
ppLexeme Lexeme Text
var
LiteralExpr LiteralType
_ Lexeme Text
l -> Doc -> Doc
dullred (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
SizeofExpr Doc
arg -> Doc
kwSizeof Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
arg
SizeofType Doc
arg -> Doc
kwSizeof Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
arg
BinaryExpr Doc
l BinaryOp
o Doc
r -> Doc
l Doc -> Doc -> Doc
<+> BinaryOp -> Doc
ppBinaryOp BinaryOp
o Doc -> Doc -> Doc
<+> Doc
r
AssignExpr Doc
l AssignOp
o Doc
r -> Doc
l Doc -> Doc -> Doc
<+> AssignOp -> Doc
ppAssignOp AssignOp
o Doc -> Doc -> Doc
<+> Doc
r
TernaryExpr Doc
c Doc
t Doc
e -> Doc -> Doc -> Doc -> Doc
ppTernaryExpr Doc
c Doc
t Doc
e
UnaryExpr UnaryOp
o Doc
e -> UnaryOp -> Doc
ppUnaryOp UnaryOp
o Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e
ParenExpr Doc
e -> Doc -> Doc
parens Doc
e
FunctionCall Doc
c [Doc]
a -> Doc -> [Doc] -> Doc
ppFunctionCall Doc
c [Doc]
a
ArrayAccess Doc
e Doc
i -> Doc
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
<> Doc
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'
CastExpr Doc
ty Doc
e -> Doc -> Doc
parens Doc
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e
CompoundExpr Doc
ty Doc
e -> Doc -> Doc
parens Doc
ty Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace
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 [Doc]
l -> [Doc] -> Doc
ppInitialiserList [Doc]
l
PointerAccess Doc
e Lexeme Text
m -> Doc
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 Doc
e Lexeme Text
m -> Doc
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 Doc
c Doc
e -> Doc
c Doc -> Doc -> Doc
<+> Doc
e
NodeF (Lexeme Text) Doc
Ellipsis -> String -> Doc
text String
"..."
VarDecl Doc
ty Lexeme Text
name [Doc]
arrs -> Doc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat [Doc]
arrs
DeclSpecArray Maybe Doc
Nothing -> String -> Doc
text String
"[]"
DeclSpecArray (Just Doc
dim) -> Doc -> Doc
brackets Doc
dim
TyPointer Doc
ty -> Doc
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'*'
TyConst Doc
ty -> Doc
ty Doc -> Doc -> Doc
<+> Doc
kwConst
TyUserDefined Lexeme Text
l -> Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
TyStd Lexeme Text
l -> Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
TyFunc Lexeme Text
l -> Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
TyStruct Lexeme Text
l -> Doc
kwStruct Doc -> Doc -> Doc
<+> Doc -> Doc
dullgreen (Lexeme Text -> Doc
ppLexeme Lexeme Text
l)
ExternC [Doc]
decls ->
Doc -> Doc
dullmagenta (String -> Doc
text String
"#ifdef __cplusplus") Doc -> Doc -> Doc
<$>
String -> Doc
text String
"extern \"C\" {" Doc -> Doc -> Doc
<$>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif") Doc -> Doc -> Doc
<$>
Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
[Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
<$>
Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#ifdef __cplusplus") Doc -> Doc -> Doc
<$>
String -> Doc
text String
"}" Doc -> Doc -> Doc
<$>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif")
MacroParam Lexeme Text
l -> Lexeme Text -> Doc
ppLexeme Lexeme Text
l
MacroBodyFunCall Doc
e -> Doc
e
MacroBodyStmt Doc
body ->
if Bool
False
then Doc
kwDo Doc -> Doc -> Doc
<+> Doc
body Doc -> Doc -> Doc
<+> Doc
kwWhile Doc -> Doc -> Doc
<+> String -> Doc
text String
"(0)"
else String -> Doc
text String
"do { nothing(); } while (0) // macros aren't supported well yet"
PreprocScopedDefine Doc
def [Doc]
stmts Doc
undef ->
Doc
def Doc -> Doc -> Doc
<$> [Doc] -> Doc
ppToplevel [Doc]
stmts Doc -> Doc -> Doc
<$> Doc
undef
PreprocInclude Lexeme Text
hdr ->
Doc -> Doc
dullmagenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"#include" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
hdr
PreprocDefine Lexeme Text
name ->
Doc -> Doc
dullmagenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"#define" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name
PreprocDefineConst Lexeme Text
name Doc
value ->
Doc -> Doc
dullmagenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"#define" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
value
PreprocDefineMacro Lexeme Text
name [Doc]
params Doc
body ->
Doc -> Doc
dullmagenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 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
<> [Doc] -> Doc
ppParamList [Doc]
params Doc -> Doc -> Doc
<+> Doc
body
PreprocUndef Lexeme Text
name ->
Doc -> Doc
dullmagenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"#undef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name
PreprocIf Doc
cond [Doc]
decls Doc
elseBranch ->
Doc -> Doc
dullmagenta (String -> Doc
text String
"#if" Doc -> Doc -> Doc
<+> Doc
cond) Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
elseBranch Doc -> Doc -> Doc
<$>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif")
PreprocIfdef Lexeme Text
name [Doc]
decls Doc
elseBranch ->
Doc -> Doc
dullmagenta (String -> Doc
text String
"#ifdef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name) Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
elseBranch Doc -> Doc -> Doc
<$>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif")
PreprocIfndef Lexeme Text
name [Doc]
decls Doc
elseBranch ->
Doc -> Doc
dullmagenta (String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name) Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
elseBranch Doc -> Doc -> Doc
<$>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif")
PreprocElse [] -> Doc
empty
PreprocElse [Doc]
decls ->
Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#else") Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
decls
PreprocElif Doc
cond [Doc]
decls Doc
elseBranch ->
Doc
hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
dullmagenta (String -> Doc
text String
"#elif") Doc -> Doc -> Doc
<+> Doc
cond Doc -> Doc -> Doc
<$>
[Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
elseBranch
CallbackDecl Lexeme Text
ty Lexeme Text
name ->
Lexeme Text -> Doc
ppLexeme Lexeme Text
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name
FunctionPrototype Doc
ty Lexeme Text
name [Doc]
params ->
Doc -> Lexeme Text -> [Doc] -> Doc
ppFunctionPrototype Doc
ty Lexeme Text
name [Doc]
params
FunctionDecl Scope
scope Doc
proto ->
Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
proto Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
FunctionDefn Scope
scope Doc
proto Doc
body ->
Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
proto Doc -> Doc -> Doc
<+> Doc
body
MemberDecl Doc
decl Maybe (Lexeme Text)
Nothing ->
Doc
decl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
MemberDecl Doc
decl (Just Lexeme Text
size) ->
Doc
decl Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
size Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
AggregateDecl Doc
struct -> Doc
struct Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Struct Lexeme Text
name [Doc]
members ->
Int -> Doc -> Doc
nest Int
2 (
Doc
kwStruct Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
members
) Doc -> Doc -> Doc
<$> Doc
rbrace
Union Lexeme Text
name [Doc]
members ->
Int -> Doc -> Doc
nest Int
2 (
Doc
kwUnion Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
members
) Doc -> Doc -> Doc
<$> Doc
rbrace
Typedef Doc
ty Lexeme Text
tyname ->
Doc
kwTypedef Doc -> Doc -> Doc
<+> Doc
ty Doc -> Doc -> Doc
<+> Doc -> Doc
dullgreen (Lexeme Text -> Doc
ppLexeme Lexeme Text
tyname) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
TypedefFunction Doc
proto ->
Doc
kwTypedef Doc -> Doc -> Doc
<+> Doc
proto Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ConstDecl Doc
ty Lexeme Text
name ->
Doc
kwExtern Doc -> Doc -> Doc
<+> Doc
kwConst Doc -> Doc -> Doc
<+> Doc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
ConstDefn Scope
scope Doc
ty Lexeme Text
name Doc
value ->
Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
kwConst Doc -> Doc -> Doc
<+>
Doc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Enumerator Lexeme Text
name Maybe Doc
Nothing -> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma
Enumerator Lexeme Text
name (Just Doc
value) ->
Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma
EnumConsts Maybe (Lexeme Text)
Nothing [Doc]
enums ->
Int -> Doc -> Doc
nest Int
2 (
Doc
kwEnum Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
enums
) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
EnumConsts (Just Lexeme Text
name) [Doc]
enums ->
Int -> Doc -> Doc
nest Int
2 (
Doc
kwEnum Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
enums
) Doc -> Doc -> Doc
<$> String -> Doc
text String
"};"
EnumDecl Lexeme Text
name [Doc]
enums Lexeme Text
ty ->
Int -> Doc -> Doc
nest Int
2 (
Doc
kwTypedef Doc -> Doc -> Doc
<+> Doc
kwEnum Doc -> Doc -> Doc
<+> Doc -> Doc
dullgreen (Lexeme Text -> Doc
ppLexeme Lexeme Text
name) Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
[Doc] -> Doc
vcat [Doc]
enums
) Doc -> Doc -> Doc
<$> Doc
rbrace Doc -> Doc -> Doc
<+> Doc -> Doc
dullgreen (Lexeme Text -> Doc
ppLexeme Lexeme Text
ty) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
NonNull [Lexeme Text]
args Doc
f ->
Doc
kwNonNull Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
args Doc -> Doc -> Doc
<$> Doc
f
Nullable [Lexeme Text]
args Doc
f ->
Doc
kwNullable Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
args Doc -> Doc -> Doc
<$> Doc
f
VarDeclStmt Doc
decl Maybe Doc
Nothing -> Doc
decl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
VarDeclStmt Doc
decl (Just Doc
initr) -> Doc
decl Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
initr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Return Maybe Doc
Nothing -> Doc
kwReturn Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Return (Just Doc
e) -> Doc
kwReturn Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
NodeF (Lexeme Text) Doc
Continue -> Doc
kwContinue Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
NodeF (Lexeme Text) Doc
Break -> Doc
kwBreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
IfStmt Doc
cond Doc
t Maybe Doc
e -> Doc -> Doc -> Maybe Doc -> Doc
ppIfStmt Doc
cond Doc
t Maybe Doc
e
ForStmt Doc
i Doc
c Doc
n Doc
body -> Doc -> Doc -> Doc -> Doc -> Doc
ppForStmt Doc
i Doc
c Doc
n Doc
body
Default Doc
s -> Doc
kwDefault Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Doc
s
Label Lexeme Text
l Doc
s -> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<$> Doc
s
ExprStmt Doc
e -> Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Goto Lexeme Text
l -> Doc
kwGoto Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
Case Doc
e Doc
s -> Doc
kwCase Doc -> Doc -> Doc
<+> Doc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Doc
s
WhileStmt Doc
c Doc
body -> Doc -> Doc -> Doc
ppWhileStmt Doc
c Doc
body
DoWhileStmt Doc
body Doc
c -> Doc -> Doc -> Doc
ppDoWhileStmt Doc
body Doc
c
SwitchStmt Doc
c [Doc]
body -> Doc -> [Doc] -> Doc
ppSwitchStmt Doc
c [Doc]
body
CompoundStmt [Doc]
body -> [Doc] -> Doc
ppCompoundStmt [Doc]
body
VLA Doc
ty Lexeme Text
n Doc
sz -> Doc -> Lexeme Text -> Doc -> Doc
ppVLA Doc
ty Lexeme Text
n Doc
sz
ppToplevel :: [Doc] -> Doc
ppToplevel :: [Doc] -> Doc
ppToplevel = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
line
ppTranslationUnit :: [Node (Lexeme Text)] -> Doc
ppTranslationUnit :: [Node (Lexeme Text)] -> Doc
ppTranslationUnit [Node (Lexeme Text)]
decls = ([Doc] -> Doc
ppToplevel ([Doc] -> Doc)
-> ([Node (Lexeme Text)] -> [Doc]) -> [Node (Lexeme Text)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme Text) -> Doc) -> [Node (Lexeme Text)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> Doc
ppNode ([Node (Lexeme Text)] -> Doc) -> [Node (Lexeme Text)] -> Doc
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
decls) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak
showNode :: Node (Lexeme Text) -> Text
showNode :: Node (Lexeme Text) -> Text
showNode = String -> Text
Text.pack (String -> Text)
-> (Node (Lexeme Text) -> String) -> Node (Lexeme Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (Node (Lexeme Text) -> Doc) -> Node (Lexeme Text) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node (Lexeme Text) -> Doc
ppNode