{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Cimple.Pretty
    ( plain
    , render
    , 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 (..),
                                               Comment, CommentF (..),
                                               CommentStyle (..), Lexeme (..),
                                               LexemeClass (..), Node,
                                               NodeF (..), Scope (..),
                                               UnaryOp (..), lexemeLine,
                                               lexemeText)
import           Prelude                      hiding ((<$>))
import           Text.PrettyPrint.ANSI.Leijen

indentWidth :: Int
indentWidth :: Int
indentWidth = Int
2

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"
kwGnuPrintf :: Doc
kwGnuPrintf     = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"GNU_PRINTF"
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"
kwNonNull :: Doc
kwNonNull       = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"non_null"
kwNullable :: Doc
kwNullable      = Doc -> Doc
dullgreen (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"nullable"
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"

kwDocAttention :: Doc
kwDocAttention  = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@attention"
kwDocBrief :: Doc
kwDocBrief      = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@brief"
kwDocDeprecated :: Doc
kwDocDeprecated = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@deprecated"
kwDocExtends :: Doc
kwDocExtends    = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@extends"
kwDocImplements :: Doc
kwDocImplements = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@implements"
kwDocParam :: Doc
kwDocParam      = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@param"
kwDocPrivate :: Doc
kwDocPrivate    = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@private"
kwDocRef :: Doc
kwDocRef        = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@ref"
kwDocReturn :: Doc
kwDocReturn     = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@return"
kwDocRetval :: Doc
kwDocRetval     = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@retval"
kwDocP :: Doc
kwDocP          = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@p"
kwDocSee :: Doc
kwDocSee        = Doc -> Doc
dullcyan (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"@see"

cmtPrefix :: Doc
cmtPrefix :: Doc
cmtPrefix = Doc -> Doc
dullyellow (Char -> Doc
char Char
'*')

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
"--"

ppCommentStart :: CommentStyle -> Doc
ppCommentStart :: CommentStyle -> Doc
ppCommentStart = 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
Section -> String -> Doc
text String
"/** @{"
    CommentStyle
Regular -> String -> Doc
text String
"/*"
    CommentStyle
Ignore  -> String -> Doc
text String
"//!TOKSTYLE-"

ppCommentBody :: [Lexeme Text] -> Doc
ppCommentBody :: [Lexeme Text] -> Doc
ppCommentBody [Lexeme Text]
body = [Doc] -> Doc
vsep ([Doc] -> Doc) -> ([Lexeme Text] -> [Doc]) -> [Lexeme Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> [Doc]
prefixStars ([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 ([Lexeme Text] -> Doc) -> [Lexeme Text] -> Doc
forall a b. (a -> b) -> a -> b
$ [Lexeme Text]
body
  where
    -- If the "*/" is on a separate line, don't add an additional "*" before
    -- it. If "*/" is on the same line, then do add a "*" prefix on the last line.
    stars :: Int
stars =
        case [Lexeme Text] -> [Lexeme Text]
forall a. [a] -> [a]
reverse [Lexeme Text]
body of
          Lexeme Text
e:Lexeme Text
c:[Lexeme Text]
_ | Lexeme Text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme Text
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Lexeme Text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme Text
c -> Int
2
          [Lexeme Text]
_                                   -> Int
1
    prefixStars :: [Doc] -> [Doc]
prefixStars [Doc]
xs = (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (Doc
empty Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate ([Doc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
stars) Doc
cmtPrefix [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
empty]) [Doc]
xs
    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
empty
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
ppComment :: CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc
ppComment CommentStyle
Ignore [Lexeme Text]
cs Lexeme Text
_ =
    CommentStyle -> Doc
ppCommentStart CommentStyle
Ignore Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat ((Lexeme Text -> Doc) -> [Lexeme Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme Text -> Doc
ppWord [Lexeme Text]
cs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
dullyellow (String -> Doc
text String
"//!TOKSTYLE+" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line)
ppComment 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
ppCommentStart 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
. Int -> Doc -> Doc
indent Int
0 (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
indentWidth (
        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
indentWidth (
        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
ppCommentStart 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)

ppMacroBody :: Doc -> Doc
ppMacroBody :: Doc -> Doc
ppMacroBody =
    [Doc] -> Doc
vcat
    ([Doc] -> Doc) -> (Doc -> [Doc]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
dullmagenta
    ([Doc] -> [Doc]) -> (Doc -> [Doc]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" \\")
    ([Doc] -> [Doc]) -> (Doc -> [Doc]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
    ([String] -> [Doc]) -> (Doc -> [String]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn String
"\n"
    (String -> [String]) -> (Doc -> String) -> Doc -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderS
    (Doc -> String) -> (Doc -> Doc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
plain

ppVerbatimComment :: Doc -> Doc
ppVerbatimComment :: Doc -> Doc
ppVerbatimComment =
    [Doc] -> Doc
vcat
    ([Doc] -> Doc) -> (Doc -> [Doc]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
dullyellow
    ([Doc] -> [Doc]) -> (Doc -> [Doc]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (Doc
empty Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (String -> Doc
text String
" * "))
    ([Doc] -> [Doc]) -> (Doc -> [Doc]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
    ([String] -> [Doc]) -> (Doc -> [String]) -> Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn String
"\n"
    (String -> [String]) -> (Doc -> String) -> Doc -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderS
    (Doc -> String) -> (Doc -> Doc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
plain

ppCommentInfo :: Comment (Lexeme Text) -> Doc
ppCommentInfo :: Comment (Lexeme Text) -> Doc
ppCommentInfo = (CommentF (Lexeme Text) Doc -> Doc) -> Comment (Lexeme Text) -> Doc
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix CommentF (Lexeme Text) Doc -> Doc
go
  where
  ppBody :: [Doc] -> Doc
ppBody     = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (        Doc -> [Doc]
forall a. a -> [a]
repeat (Doc -> Doc
dullyellow (String -> Doc
text String
" * "  )))
  ppIndented :: [Doc] -> Doc
ppIndented = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (Doc
empty Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Doc -> Doc
dullyellow (String -> Doc
text String
" *   ")))
  ppRef :: Lexeme Text -> Doc
ppRef      = Doc -> Doc
underline (Doc -> Doc) -> (Lexeme Text -> Doc) -> Lexeme Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
cyan (Doc -> Doc) -> (Lexeme Text -> Doc) -> Lexeme Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Doc
ppLexeme
  ppAttr :: Maybe (Lexeme Text) -> Doc
ppAttr     = Doc -> (Lexeme Text -> Doc) -> Maybe (Lexeme Text) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
blue (Doc -> Doc) -> (Lexeme Text -> Doc) -> Lexeme Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Doc
ppLexeme)

  go :: CommentF (Lexeme Text) Doc -> Doc
  go :: CommentF (Lexeme Text) Doc -> Doc
go = Doc -> Doc
dullyellow (Doc -> Doc)
-> (CommentF (Lexeme Text) Doc -> Doc)
-> CommentF (Lexeme Text) Doc
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    DocComment [Doc]
docs ->
        String -> Doc
text String
"/**" Doc -> Doc -> Doc
<$>
        [Doc] -> Doc
ppBody [Doc]
docs Doc -> Doc -> Doc
<$>
        Doc -> Doc
dullyellow (String -> Doc
text String
" */")
    DocWord Lexeme Text
w -> Lexeme Text -> Doc
ppLexeme Lexeme Text
w
    DocSentence [Doc]
docs Lexeme Text
ending -> [Doc] -> Doc
fillSep [Doc]
docs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc
ppLexeme Lexeme Text
ending
    CommentF (Lexeme Text) Doc
DocNewline -> Doc
empty

    DocParam Maybe (Lexeme Text)
attr Lexeme Text
name [Doc]
docs ->
        Doc
kwDocParam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Maybe (Lexeme Text) -> Doc
ppAttr Maybe (Lexeme Text)
attr Doc -> Doc -> Doc
<+> Doc -> Doc
underline (Doc -> Doc
cyan (Lexeme Text -> Doc
ppLexeme Lexeme Text
name)) Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs

    DocAttention [Doc]
docs   -> Doc
kwDocAttention  Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocBrief [Doc]
docs       -> Doc
kwDocBrief      Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocDeprecated [Doc]
docs  -> Doc
kwDocDeprecated Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocReturn [Doc]
docs      -> Doc
kwDocReturn     Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocRetval Lexeme Text
expr [Doc]
docs -> Doc
kwDocRetval     Doc -> Doc -> Doc
<+> Doc -> Doc
dullred (Lexeme Text -> Doc
ppLexeme Lexeme Text
expr) Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocSee Lexeme Text
name [Doc]
docs    -> Doc
kwDocSee        Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppRef Lexeme Text
name Doc -> Doc -> Doc
<+> [Doc] -> Doc
ppIndented [Doc]
docs
    DocRef Lexeme Text
name         -> Doc
kwDocRef        Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppRef Lexeme Text
name
    DocP Lexeme Text
name           -> Doc
kwDocP          Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppRef Lexeme Text
name
    DocExtends Lexeme Text
feat     -> Doc
kwDocExtends    Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
feat
    DocImplements Lexeme Text
feat  -> Doc
kwDocImplements Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
feat
    CommentF (Lexeme Text) Doc
DocPrivate          -> Doc
kwDocPrivate

    DocParagraph [Doc]
docs -> [Doc] -> Doc
ppIndented [Doc]
docs
    DocLine [Doc]
docs -> [Doc] -> Doc
fillSep [Doc]
docs
    DocList [Doc]
l -> Doc -> Doc
ppVerbatimComment (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
l
    DocOLItem Lexeme Text
num [Doc]
docs -> Lexeme Text -> Doc
ppLexeme Lexeme Text
num Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
3 ([Doc] -> Doc
fillSep [Doc]
docs)
    DocULItem [Doc]
docs [Doc]
sublist -> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fillSep [Doc]
docs Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
sublist)

    DocLParen Doc
doc -> Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc
    DocRParen Doc
doc -> Doc
doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen
    DocColon Lexeme Text
doc -> Lexeme Text -> Doc
ppLexeme Lexeme Text
doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':'
    DocBinaryOp BinaryOp
BopMinus Doc
l Doc
r -> Doc
l 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
r
    DocBinaryOp BinaryOp
BopDiv   Doc
l Doc
r -> Doc
l 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
r
    DocAssignOp AssignOp
op       Doc
l Doc
r -> Doc
l Doc -> Doc -> Doc
<+> AssignOp -> Doc
ppAssignOp AssignOp
op Doc -> Doc -> Doc
<+> Doc
r
    DocBinaryOp BinaryOp
op       Doc
l Doc
r -> Doc
l Doc -> Doc -> Doc
<+> BinaryOp -> Doc
ppBinaryOp BinaryOp
op Doc -> Doc -> Doc
<+> Doc
r

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
end ->
        CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc
ppComment CommentStyle
style [Lexeme Text]
cs Lexeme Text
end
    CommentSection Doc
start [Doc]
decls Doc
end ->
        Doc
start Doc -> Doc -> Doc
<$> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
ppToplevel [Doc]
decls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
<$> Doc
end
    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
    CommentInfo Comment (Lexeme Text)
docs ->
        Comment (Lexeme Text) -> Doc
ppCommentInfo Comment (Lexeme Text)
docs

    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  -- DEPRECATED
    CompoundLiteral 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
<$>
        Doc
kwExtern Doc -> Doc -> Doc
<+> Doc -> Doc
dullred (String -> Doc
text String
"\"C\"") Doc -> Doc -> Doc
<+> Doc
lbrace 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
<$>
        Doc
rbrace Doc -> Doc -> Doc
<$>
        Doc -> Doc
dullmagenta (String -> Doc
text String
"#endif")

    Group [Doc]
decls -> [Doc] -> Doc
vcat [Doc]
decls

    MacroParam Lexeme Text
l -> Lexeme Text -> Doc
ppLexeme Lexeme Text
l

    MacroBodyFunCall Doc
e -> Doc
e
    MacroBodyStmt Doc
body ->
        Doc
kwDo Doc -> Doc -> Doc
<+> Doc
body Doc -> Doc -> Doc
<+> Doc
kwWhile Doc -> Doc -> Doc
<+> String -> Doc
text String
"(0)"

    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
ppMacroBody (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  //" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name)
    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  //" Doc -> Doc -> Doc
<+> Lexeme Text -> Doc
ppLexeme Lexeme Text
name)
    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

    AttrPrintf Lexeme Text
fmt Lexeme Text
ellipsis Doc
fun ->
        Doc
kwGnuPrintf Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text
fmt, Lexeme Text
ellipsis] Doc -> Doc -> Doc
<$> Doc
fun
    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
indentWidth (
            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
indentWidth (
            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
indentWidth (
            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
indentWidth (
            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
indentWidth (
            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 [] [] Doc
f ->
        Doc
kwNonNull Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"()" Doc -> Doc -> Doc
<$> Doc
f
    NonNull [Lexeme Text]
nonnull [] Doc
f ->
        Doc
kwNonNull Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
nonnull Doc -> Doc -> Doc
<$> Doc
f
    NonNull [] [Lexeme Text]
nullable Doc
f ->
        Doc
kwNullable Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
nullable Doc -> Doc -> Doc
<$> Doc
f
    NonNull [Lexeme Text]
nonnull [Lexeme Text]
nullable Doc
f ->
        Doc
kwNonNull Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
nonnull Doc -> Doc -> Doc
<+> Doc
kwNullable Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc
ppIntList [Lexeme Text]
nullable Doc -> Doc -> Doc
<$> Doc
f

    -- Statements
    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                     -> Int -> Doc -> Doc
indent (-Int
99) (Doc
line 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
<> 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

renderS :: Doc -> String
renderS :: Doc -> String
renderS = (SimpleDoc -> String -> String) -> String -> SimpleDoc -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleDoc -> String -> String
displayS String
"" (SimpleDoc -> String) -> (Doc -> SimpleDoc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
renderSmart Float
1 Int
120

render :: Doc -> Text
render :: Doc -> Text
render = String -> Text
Text.pack (String -> Text) -> (Doc -> String) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderS