{-# LANGUAGE LambdaCase    #-}
{-# LANGUAGE TupleSections #-}
module Language.Cimple.Pretty (ppTranslationUnit, showNode) where

import           Data.Fix                     (foldFix)
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,
                                               NodeF (..), Scope (..),
                                               UnaryOp (..), lexemeText)
import           Prelude                      hiding ((<$>))
import           Text.Groom                   (groom)
import           Text.PrettyPrint.ANSI.Leijen hiding (semi)

-- | Whether a node needs a semicolon at the end when it's a statement or
-- declaration.
data NeedsSemi
    = SemiNo
    | SemiYes

-- | Annotated Doc which is passed upwards through the fold. 'fst' is the
-- accumulated pretty-printed code. 'snd' states whether the current statement
-- should end in a semicolon ';'. E.g. function definitions don't, while
-- function declarations do.
type ADoc = (Doc, NeedsSemi)
bare, semi :: Doc -> ADoc
bare :: Doc -> ADoc
bare = (, NeedsSemi
SemiNo)
semi :: Doc -> ADoc
semi = (, NeedsSemi
SemiYes)

-- | Copy the 'NeedsSemi' from another 'ADoc' to a newly created doc.
cp :: ADoc -> Doc -> ADoc
cp :: ADoc -> Doc -> ADoc
cp (Doc
_, NeedsSemi
s) Doc
d = (Doc
d, NeedsSemi
s)

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

ppSep :: Doc -> [ADoc] -> Doc
ppSep :: Doc -> [ADoc] -> Doc
ppSep Doc
s = (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) -> ([ADoc] -> [Doc]) -> [ADoc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse Doc
s ([Doc] -> [Doc]) -> ([ADoc] -> [Doc]) -> [ADoc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ADoc -> Doc) -> [ADoc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ADoc -> Doc
forall a b. (a, b) -> a
fst

ppCommaSep :: [ADoc] -> Doc
ppCommaSep :: [ADoc] -> Doc
ppCommaSep = Doc -> [ADoc] -> Doc
ppSep (String -> Doc
text String
", ")

ppLineSep :: [ADoc] -> Doc
ppLineSep :: [ADoc] -> Doc
ppLineSep = Doc -> [ADoc] -> Doc
ppSep Doc
linebreak

ppSemiSep :: [ADoc] -> Doc
ppSemiSep :: [ADoc] -> Doc
ppSemiSep = Doc -> [ADoc] -> Doc
ppEnd (Char -> Doc
char Char
';')
  where
    ppEnd :: Doc -> [ADoc] -> Doc
ppEnd Doc
s = (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) -> ([ADoc] -> [Doc]) -> [ADoc] -> 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]) -> ([ADoc] -> [Doc]) -> [ADoc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ADoc -> Doc) -> [ADoc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> ADoc -> Doc
forall {a}. Semigroup a => a -> (a, NeedsSemi) -> a
addEnd Doc
s)

    addEnd :: a -> (a, NeedsSemi) -> a
addEnd a
s (a
d, NeedsSemi
SemiYes) = a
d a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s
    addEnd a
_ (a
d, NeedsSemi
SemiNo)  = a
d

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

ppAssignOp :: AssignOp -> Doc
ppAssignOp :: AssignOp -> Doc
ppAssignOp = \case
    AssignOp
AopEq     -> Char -> Doc
char Char
'='
    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
ppCommentStyle :: CommentStyle -> Doc
ppCommentStyle = \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 = [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
$ String
"ppWord: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> String
forall a. Show a => a -> String
groom Lexeme Text
x

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

ppInitialiserList :: [ADoc] -> Doc
ppInitialiserList :: [ADoc] -> Doc
ppInitialiserList [ADoc]
l = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<+> [ADoc] -> Doc
ppCommaSep [ADoc]
l Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'}'

ppFunctionParamList :: [ADoc] -> Doc
ppFunctionParamList :: [ADoc] -> Doc
ppFunctionParamList [ADoc]
xs = Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ADoc] -> Doc
ppCommaSep [ADoc]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppFunctionPrototype
    :: ADoc
    -> Lexeme Text
    -> [ADoc]
    -> Doc
ppFunctionPrototype :: ADoc -> Lexeme Text -> [ADoc] -> Doc
ppFunctionPrototype ADoc
ty Lexeme Text
name [ADoc]
params =
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ADoc] -> Doc
ppFunctionParamList [ADoc]
params

ppFunctionCall :: ADoc -> [ADoc] -> Doc
ppFunctionCall :: ADoc -> [ADoc] -> Doc
ppFunctionCall ADoc
callee [ADoc]
args =
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> [ADoc] -> Doc
ppCommaSep [ADoc]
args Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppMacroParamList :: [ADoc] -> Doc
ppMacroParamList :: [ADoc] -> Doc
ppMacroParamList [ADoc]
xs = Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [ADoc] -> Doc
ppCommaSep [ADoc]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppIfStmt
    :: ADoc
    -> ADoc
    -> Maybe ADoc
    -> Doc
ppIfStmt :: ADoc -> ADoc -> Maybe ADoc -> Doc
ppIfStmt ADoc
cond ADoc
t Maybe ADoc
Nothing =
    String -> Doc
text String
"if (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
t
ppIfStmt ADoc
cond ADoc
t (Just ADoc
e) =
    String -> Doc
text String
"if (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
cond Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"else" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e

ppForStmt
    :: ADoc
    -> ADoc
    -> ADoc
    -> ADoc
    -> Doc
ppForStmt :: ADoc -> ADoc -> ADoc -> ADoc -> Doc
ppForStmt ADoc
i ADoc
c ADoc
n ADoc
body =
    String -> Doc
text String
"for ("
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
';'
    Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
n
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')' Doc -> Doc -> Doc
<+>
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body

ppWhileStmt
    :: ADoc
    -> ADoc
    -> Doc
ppWhileStmt :: ADoc -> ADoc -> Doc
ppWhileStmt ADoc
c ADoc
body =
    String -> Doc
text String
"while ("
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')' Doc -> Doc -> Doc
<+>
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body

ppDoWhileStmt
    :: ADoc
    -> ADoc
    -> Doc
ppDoWhileStmt :: ADoc -> ADoc -> Doc
ppDoWhileStmt ADoc
body ADoc
c =
    String -> Doc
text String
"do ("
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body
    Doc -> Doc -> Doc
<+> String -> Doc
text String
"while (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppSwitchStmt
    :: ADoc
    -> [ADoc]
    -> Doc
ppSwitchStmt :: ADoc -> [ADoc] -> Doc
ppSwitchStmt ADoc
c [ADoc]
body =
    Int -> Doc -> Doc
nest Int
2 (
        String -> Doc
text String
"switch ("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
") {" Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppVLA :: ADoc -> Lexeme Text -> ADoc -> Doc
ppVLA :: ADoc -> Lexeme Text -> ADoc -> Doc
ppVLA ADoc
ty Lexeme Text
n ADoc
sz =
    String -> Doc
text String
"VLA("
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
sz
        Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'

ppCompoundStmt :: [ADoc] -> Doc
ppCompoundStmt :: [ADoc] -> Doc
ppCompoundStmt [ADoc]
body =
    Int -> Doc -> Doc
nest Int
2 (
        Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
body
    ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'

ppTernaryExpr
    :: ADoc
    -> ADoc
    -> ADoc
    -> Doc
ppTernaryExpr :: ADoc -> ADoc -> ADoc -> Doc
ppTernaryExpr ADoc
c ADoc
t ADoc
e =
    ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
t Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e

ppLicenseDecl :: Lexeme Text -> [ADoc] -> Doc
ppLicenseDecl :: Lexeme Text -> [ADoc] -> Doc
ppLicenseDecl Lexeme Text
l [ADoc]
cs =
    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
<$>
    [ADoc] -> Doc
ppLineSep [ADoc]
cs Doc -> Doc -> Doc
<$>
    String -> Doc
text String
" */"

ppNode :: Node (Lexeme Text) -> ADoc
ppNode :: Node (Lexeme Text) -> ADoc
ppNode = (NodeF (Lexeme Text) ADoc -> ADoc) -> Node (Lexeme Text) -> ADoc
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme Text) ADoc -> ADoc
go
  where
  go :: NodeF (Lexeme Text) ADoc -> ADoc
  go :: NodeF (Lexeme Text) ADoc -> ADoc
go = \case
    StaticAssert ADoc
cond Lexeme Text
msg -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"static_assert(" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> Char -> Doc
char Char
')'

    LicenseDecl Lexeme Text
l [ADoc]
cs -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> [ADoc] -> Doc
ppLicenseDecl Lexeme Text
l [ADoc]
cs
    CopyrightDecl Lexeme Text
from (Just Lexeme Text
to) [Lexeme Text]
owner -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
forall a. Semigroup a => a -> a -> a
<>
        [Lexeme Text] -> Doc
ppCommentBody [Lexeme Text]
owner
    CopyrightDecl Lexeme Text
from Maybe (Lexeme Text)
Nothing [Lexeme Text]
owner -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
<>
        [Lexeme Text] -> Doc
ppCommentBody [Lexeme Text]
owner

    Comment CommentStyle
style Lexeme Text
_ [Lexeme Text]
cs Lexeme Text
_ -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        CommentStyle -> [Lexeme Text] -> Doc
ppComment CommentStyle
style [Lexeme Text]
cs
    CommentBlock Lexeme Text
cs -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Lexeme Text -> Doc
ppLexeme Lexeme Text
cs
    Commented (Doc
c, NeedsSemi
_) (Doc
d, NeedsSemi
s) -> (, NeedsSemi
s) (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Doc
c Doc -> Doc -> Doc
<$> Doc
d

    VarExpr Lexeme Text
var       -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
var
    LiteralExpr LiteralType
_ Lexeme Text
l   -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    SizeofExpr ADoc
arg    -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
arg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    SizeofType ADoc
arg    -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"sizeof(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
arg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    BinaryExpr  ADoc
l BinaryOp
o ADoc
r -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
l Doc -> Doc -> Doc
<+> BinaryOp -> Doc
ppBinaryOp BinaryOp
o Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
r
    AssignExpr  ADoc
l AssignOp
o ADoc
r -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
l Doc -> Doc -> Doc
<+> AssignOp -> Doc
ppAssignOp AssignOp
o Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
r
    TernaryExpr ADoc
c ADoc
t ADoc
e -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> ADoc -> ADoc -> Doc
ppTernaryExpr ADoc
c ADoc
t ADoc
e
    UnaryExpr UnaryOp
o ADoc
e     -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ UnaryOp -> Doc
ppUnaryOp UnaryOp
o Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e
    ParenExpr ADoc
e       -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
')'
    FunctionCall ADoc
c  [ADoc]
a -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> [ADoc] -> Doc
ppFunctionCall ADoc
c [ADoc]
a
    ArrayAccess  ADoc
e  ADoc
i -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'
    CastExpr     ADoc
ty ADoc
e -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e
    CompoundExpr ADoc
ty ADoc
e -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'(' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'}'
    PreprocDefined  Lexeme Text
n -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ 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 [ADoc]
l -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ [ADoc] -> Doc
ppInitialiserList [ADoc]
l
    PointerAccess ADoc
e Lexeme Text
m -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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  ADoc
e Lexeme Text
m -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
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   ADoc
c ADoc
e -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
c Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e
    NodeF (Lexeme Text) ADoc
Ellipsis          -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"..."

    VarDecl ADoc
ty Lexeme Text
name [ADoc]
arrs      -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> [ADoc] -> Doc
ppSep Doc
empty [ADoc]
arrs
    DeclSpecArray Maybe ADoc
Nothing     -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"[]"
    DeclSpecArray (Just ADoc
dim)  -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'[' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
dim Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
']'

    TyPointer     ADoc
ty -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'*'
    TyConst       ADoc
ty -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> String -> Doc
text String
"const"
    TyUserDefined Lexeme Text
l  -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    TyStd         Lexeme Text
l  -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    TyFunc        Lexeme Text
l  -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    TyStruct      Lexeme Text
l  -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"struct" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
l

    ExternC [ADoc]
decls -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
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"

    MacroParam Lexeme Text
l -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l

    MacroBodyFunCall ADoc
e -> ADoc
e
    MacroBodyStmt ADoc
body -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"do" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body Doc -> Doc -> Doc
<+> String -> Doc
text String
"while (0)"

    PreprocScopedDefine ADoc
def [ADoc]
stmts ADoc
undef -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
def Doc -> Doc -> Doc
<$> [ADoc] -> Doc
ppSemiSep [ADoc]
stmts Doc -> Doc -> Doc
<$> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
undef

    PreprocInclude Lexeme Text
hdr -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
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 -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
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 ADoc
value -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
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
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
value
    PreprocDefineMacro Lexeme Text
name [ADoc]
params ADoc
body -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
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
<> [ADoc] -> Doc
ppMacroParamList [ADoc]
params Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body
    PreprocUndef Lexeme Text
name -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"#undef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name

    PreprocIf ADoc
cond [ADoc]
decls ADoc
elseBranch -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"#if" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
cond Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
elseBranch Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfdef Lexeme Text
name [ADoc]
decls ADoc
elseBranch -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"#ifdef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
elseBranch Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocIfndef Lexeme Text
name [ADoc]
decls ADoc
elseBranch -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
elseBranch Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"
    PreprocElse [] -> Doc -> ADoc
bare Doc
empty
    PreprocElse [ADoc]
decls -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        String -> Doc
text String
"#else" Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
decls
    PreprocElif ADoc
cond [ADoc]
decls ADoc
elseBranch -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"#elif" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
cond Doc -> Doc -> Doc
<$>
        [ADoc] -> Doc
ppSemiSep [ADoc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
elseBranch Doc -> Doc -> Doc
<$>
        String -> Doc
text String
"#endif"

    FunctionPrototype ADoc
ty Lexeme Text
name [ADoc]
params -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        ADoc -> Lexeme Text -> [ADoc] -> Doc
ppFunctionPrototype ADoc
ty Lexeme Text
name [ADoc]
params
    FunctionDecl Scope
scope ADoc
proto -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
proto
    FunctionDefn Scope
scope ADoc
proto ADoc
body -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
proto Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
body

    MemberDecl ADoc
decl Maybe (Lexeme Text)
Nothing -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
decl
    MemberDecl ADoc
decl (Just Lexeme Text
size) -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
decl Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
size

    Struct Lexeme Text
name [ADoc]
members -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
<$>
            [ADoc] -> Doc
ppSemiSep [ADoc]
members
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
    Union Lexeme Text
name [ADoc]
members -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"union" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [ADoc] -> Doc
ppSemiSep [ADoc]
members
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
    Typedef ADoc
ty Lexeme Text
tyname -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"typedef" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
tyname
    TypedefFunction ADoc
proto -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"typedef" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
proto

    ConstDecl ADoc
ty Lexeme Text
name -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        String -> Doc
text String
"extern const" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name
    ConstDefn Scope
scope ADoc
ty Lexeme Text
name ADoc
value -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Scope -> Doc
ppScope Scope
scope Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"const" Doc -> Doc -> Doc
<+>
        ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
ty Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
value

    Enumerator Lexeme Text
name  Maybe ADoc
Nothing -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
','
    Enumerator Lexeme Text
name (Just ADoc
value) -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Lexeme Text -> Doc
ppLexeme Lexeme Text
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
','

    EnumConsts Maybe (Lexeme Text)
Nothing [ADoc]
enums -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        Int -> Doc -> Doc
nest Int
2 (
            String -> Doc
text String
"enum" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$>
            [ADoc] -> Doc
ppLineSep [ADoc]
enums
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
    EnumConsts (Just Lexeme Text
name) [ADoc]
enums -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
<$>
            [ADoc] -> Doc
ppLineSep [ADoc]
enums
        ) Doc -> Doc -> Doc
<$> Char -> Doc
char Char
'}'
    EnumDecl Lexeme Text
name [ADoc]
enums Lexeme Text
ty -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$
        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
<$>
            [ADoc] -> Doc
ppLineSep [ADoc]
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

    -- Statements
    VarDeclStmt ADoc
decl Maybe ADoc
Nothing      -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
decl
    VarDeclStmt ADoc
decl (Just ADoc
initr) -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
decl Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
initr
    Return Maybe ADoc
Nothing                -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return"
    Return (Just ADoc
e)               -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e
    NodeF (Lexeme Text) ADoc
Continue                      -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"continue"
    NodeF (Lexeme Text) ADoc
Break                         -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"break"
    IfStmt ADoc
cond ADoc
t Maybe ADoc
e               -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> ADoc -> Maybe ADoc -> Doc
ppIfStmt ADoc
cond ADoc
t Maybe ADoc
e
    ForStmt ADoc
i ADoc
c ADoc
n ADoc
body            -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> ADoc -> ADoc -> ADoc -> Doc
ppForStmt ADoc
i ADoc
c ADoc
n ADoc
body
    Default ADoc
s                     -> ADoc -> Doc -> ADoc
cp ADoc
s (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"default:" Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
s
    Label Lexeme Text
l ADoc
s                     -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc
ppLexeme Lexeme Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<$> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
s
    Goto Lexeme Text
l                        -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"goto " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
l
    Case ADoc
e ADoc
s                      -> ADoc -> Doc -> ADoc
cp ADoc
s (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"case " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> ADoc -> Doc
forall a b. (a, b) -> a
fst ADoc
s
    WhileStmt ADoc
c ADoc
body              -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> ADoc -> Doc
ppWhileStmt ADoc
c ADoc
body
    DoWhileStmt ADoc
body ADoc
c            -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> ADoc -> Doc
ppDoWhileStmt ADoc
body ADoc
c
    SwitchStmt ADoc
c [ADoc]
body             -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> [ADoc] -> Doc
ppSwitchStmt ADoc
c [ADoc]
body
    CompoundStmt [ADoc]
body             -> Doc -> ADoc
bare (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ [ADoc] -> Doc
ppCompoundStmt [ADoc]
body
    VLA ADoc
ty Lexeme Text
n ADoc
sz                   -> Doc -> ADoc
semi (Doc -> ADoc) -> Doc -> ADoc
forall a b. (a -> b) -> a -> b
$ ADoc -> Lexeme Text -> ADoc -> Doc
ppVLA ADoc
ty Lexeme Text
n ADoc
sz


ppTranslationUnit :: [Node (Lexeme Text)] -> Doc
ppTranslationUnit :: [Node (Lexeme Text)] -> Doc
ppTranslationUnit [Node (Lexeme Text)]
decls = [ADoc] -> Doc
ppSemiSep ((Node (Lexeme Text) -> ADoc) -> [Node (Lexeme Text)] -> [ADoc]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> ADoc
ppNode [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
. ADoc -> Doc
forall a b. (a, b) -> a
fst (ADoc -> Doc)
-> (Node (Lexeme Text) -> ADoc) -> Node (Lexeme Text) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node (Lexeme Text) -> ADoc
ppNode