{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE LambdaCase #-}
module Language.Cimple.Pretty
    ( plain
    , render
    , renderSmart
    , ppTranslationUnit
    , showNode
    , showNodePlain
    ) where

import           Data.Fix                      (foldFix)
import qualified Data.List.Split               as List
import           Data.Text                     (Text)
import qualified Data.Text                     as Text
import qualified Data.Text.Lazy                as TL
import           Language.Cimple               (AssignOp (..), BinaryOp (..),
                                                Comment, CommentF (..),
                                                CommentStyle (..), Lexeme (..),
                                                LexemeClass (..), Node,
                                                NodeF (..), Nullability (..),
                                                Scope (..), UnaryOp (..),
                                                lexemeLine, lexemeText)
import           Language.Cimple.PrettyColor   (black, blue, cyan, dullcyan,
                                                dullgreen, dullmagenta, dullred,
                                                dullyellow, underline)
import           Language.Cimple.PrettyComment (ppCommentInfo)
import           Language.Cimple.PrettyCommon
import           Prettyprinter
import           Prettyprinter.Render.Terminal (AnsiStyle)

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

ppScope :: Scope -> Doc AnsiStyle
ppScope :: Scope -> Doc AnsiStyle
ppScope = \case
    Scope
Global -> Doc AnsiStyle
forall a. Monoid a => a
mempty
    Scope
Static -> Doc AnsiStyle
kwStatic Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
space
    Scope
Local  -> Doc AnsiStyle
forall a. Monoid a => a
mempty

ppNullability :: Nullability -> Doc AnsiStyle
ppNullability :: Nullability -> Doc AnsiStyle
ppNullability = \case
    Nullability
NullabilityUnspecified -> Doc AnsiStyle
forall a. Monoid a => a
mempty
    Nullability
Nullable               -> Doc AnsiStyle
kwNullable
    Nullability
Nonnull                -> Doc AnsiStyle
kwNonnull

ppCommentStart :: CommentStyle -> Doc AnsiStyle
ppCommentStart :: CommentStyle -> Doc AnsiStyle
ppCommentStart = Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle)
-> (CommentStyle -> Doc AnsiStyle) -> CommentStyle -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    CommentStyle
Block   -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/***"
    CommentStyle
Doxygen -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/**"
    CommentStyle
Section -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/** @{"
    CommentStyle
Regular -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/*"
    CommentStyle
Ignore  -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"//!TOKSTYLE-"

ppCommentBody :: [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
ppCommentBody :: [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
ppCommentBody [Lexeme (Doc AnsiStyle)]
body = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle])
-> [Lexeme (Doc AnsiStyle)]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> [Doc AnsiStyle]
prefixStars ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> ([Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle])
-> [Lexeme (Doc AnsiStyle)]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle)
-> [[Lexeme (Doc AnsiStyle)]] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle])
-> [Lexeme (Doc AnsiStyle)]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme (Doc AnsiStyle) -> Doc AnsiStyle)
-> [Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
ppWord ([Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle])
-> ([Lexeme (Doc AnsiStyle)] -> [Lexeme (Doc AnsiStyle)])
-> [Lexeme (Doc AnsiStyle)]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme (Doc AnsiStyle)] -> [Lexeme (Doc AnsiStyle)]
forall text. [Lexeme text] -> [Lexeme text]
spaceWords) ([[Lexeme (Doc AnsiStyle)]] -> [Doc AnsiStyle])
-> ([Lexeme (Doc AnsiStyle)] -> [[Lexeme (Doc AnsiStyle)]])
-> [Lexeme (Doc AnsiStyle)]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme (Doc AnsiStyle)] -> [[Lexeme (Doc AnsiStyle)]]
forall text. [Lexeme text] -> [[Lexeme text]]
groupLines ([Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle)
-> [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Lexeme (Doc AnsiStyle)]
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 (Doc AnsiStyle)] -> [Lexeme (Doc AnsiStyle)]
forall a. [a] -> [a]
reverse [Lexeme (Doc AnsiStyle)]
body of
          Lexeme (Doc AnsiStyle)
e:Lexeme (Doc AnsiStyle)
c:[Lexeme (Doc AnsiStyle)]
_ | Lexeme (Doc AnsiStyle) -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme (Doc AnsiStyle)
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Lexeme (Doc AnsiStyle) -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme (Doc AnsiStyle)
c -> Int
2
          [Lexeme (Doc AnsiStyle)]
_                                   -> Int
1
    prefixStars :: [Doc AnsiStyle] -> [Doc AnsiStyle]
prefixStars [Doc AnsiStyle]
xs = (Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
(<>) (Doc AnsiStyle
forall a. Monoid a => a
mempty Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
: Int -> Doc AnsiStyle -> [Doc AnsiStyle]
forall a. Int -> a -> [a]
replicate ([Doc AnsiStyle] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc AnsiStyle]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
stars) Doc AnsiStyle
cmtPrefix [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. [a] -> [a] -> [a]
++ [Doc AnsiStyle
forall a. Monoid a => a
mempty]) [Doc AnsiStyle]
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

    spaceWords :: [Lexeme text] -> [Lexeme text]
spaceWords = \case
        (L AlexPosn
c LexemeClass
p text
s:[Lexeme text]
ws) -> AlexPosn -> LexemeClass -> text -> Lexeme text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
c LexemeClass
p text
sLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
forall text. [Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        []           -> []
      where
        continue :: [Lexeme text] -> [Lexeme text]
continue [] = []
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
CmtEnd text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
PctComma text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
PctPeriod text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
PctEMark text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
PctQMark text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (w :: Lexeme text
w@(L AlexPosn
_ LexemeClass
PctRParen text
_):[Lexeme text]
ws) = Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue [w :: Lexeme text
w@(L AlexPosn
c LexemeClass
p text
s), end :: Lexeme text
end@(L AlexPosn
_ LexemeClass
CmtEnd text
_)] | Lexeme text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme text
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Lexeme text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme text
end = [AlexPosn -> LexemeClass -> text -> Lexeme text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
c LexemeClass
p text
s, Lexeme text
end]
        continue (L AlexPosn
c LexemeClass
PctLParen text
s:Lexeme text
w:[Lexeme text]
ws) = AlexPosn -> LexemeClass -> text -> Lexeme text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
c LexemeClass
PctLParen text
sLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:Lexeme text
wLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws
        continue (L AlexPosn
c LexemeClass
p text
s:[Lexeme text]
ws) = AlexPosn -> LexemeClass -> text -> Lexeme text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
c LexemeClass
p text
sLexeme text -> [Lexeme text] -> [Lexeme text]
forall a. a -> [a] -> [a]
:[Lexeme text] -> [Lexeme text]
continue [Lexeme text]
ws

ppWord :: Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
ppWord :: Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
ppWord l :: Lexeme (Doc AnsiStyle)
l@(L AlexPosn
_ LexemeClass
CmtSpace   Doc AnsiStyle
_) = Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
forall text. Lexeme text -> text
lexemeText Lexeme (Doc AnsiStyle)
l
ppWord l :: Lexeme (Doc AnsiStyle)
l@(L AlexPosn
_ LexemeClass
CmtCommand Doc AnsiStyle
_) = Doc AnsiStyle -> Doc AnsiStyle
dullcyan   (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
forall text. Lexeme text -> text
lexemeText Lexeme (Doc AnsiStyle)
l
ppWord l :: Lexeme (Doc AnsiStyle)
l@(L AlexPosn
_ LexemeClass
_          Doc AnsiStyle
_) = Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
forall text. Lexeme text -> text
lexemeText Lexeme (Doc AnsiStyle)
l

ppComment :: CommentStyle -> [Lexeme (Doc AnsiStyle)] -> Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
ppComment :: CommentStyle
-> [Lexeme (Doc AnsiStyle)]
-> Lexeme (Doc AnsiStyle)
-> Doc AnsiStyle
ppComment CommentStyle
Ignore [Lexeme (Doc AnsiStyle)]
cs Lexeme (Doc AnsiStyle)
_ =
    CommentStyle -> Doc AnsiStyle
ppCommentStart CommentStyle
Ignore Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat ((Lexeme (Doc AnsiStyle) -> Doc AnsiStyle)
-> [Lexeme (Doc AnsiStyle)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme (Doc AnsiStyle) -> Doc AnsiStyle
ppWord [Lexeme (Doc AnsiStyle)]
cs) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"//!TOKSTYLE+" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line)
ppComment CommentStyle
style [Lexeme (Doc AnsiStyle)]
cs Lexeme (Doc AnsiStyle)
end =
    Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
1 (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ CommentStyle -> Doc AnsiStyle
ppCommentStart CommentStyle
style Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
ppCommentBody ([Lexeme (Doc AnsiStyle)]
cs [Lexeme (Doc AnsiStyle)]
-> [Lexeme (Doc AnsiStyle)] -> [Lexeme (Doc AnsiStyle)]
forall a. [a] -> [a] -> [a]
++ [Lexeme (Doc AnsiStyle)
end])

ppInitialiserList :: [Doc AnsiStyle] -> Doc AnsiStyle
ppInitialiserList :: [Doc AnsiStyle] -> Doc AnsiStyle
ppInitialiserList [Doc AnsiStyle]
l = Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc AnsiStyle] -> Doc AnsiStyle
commaSep [Doc AnsiStyle]
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
rbrace

ppParamList :: [Doc AnsiStyle] -> Doc AnsiStyle
ppParamList :: [Doc AnsiStyle] -> Doc AnsiStyle
ppParamList = Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
0 (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
commaSep

ppFunctionPrototype
    :: Pretty a
    => Doc AnsiStyle
    -> Lexeme a
    -> [Doc AnsiStyle]
    -> Doc AnsiStyle
ppFunctionPrototype :: Doc AnsiStyle -> Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionPrototype Doc AnsiStyle
ty Lexeme a
name [Doc AnsiStyle]
params =
    Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppParamList [Doc AnsiStyle]
params

ppFunctionCall :: Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionCall :: Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionCall Doc AnsiStyle
callee [Doc AnsiStyle]
args =
    Doc AnsiStyle
callee Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppParamList [Doc AnsiStyle]
args

ppIfStmt
    :: Doc AnsiStyle
    -> Doc AnsiStyle
    -> Maybe (Doc AnsiStyle)
    -> Doc AnsiStyle
ppIfStmt :: Doc AnsiStyle
-> Doc AnsiStyle -> Maybe (Doc AnsiStyle) -> Doc AnsiStyle
ppIfStmt Doc AnsiStyle
cond Doc AnsiStyle
t Maybe (Doc AnsiStyle)
Nothing =
    Doc AnsiStyle
kwIf Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
cond Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
t
ppIfStmt Doc AnsiStyle
cond Doc AnsiStyle
t (Just Doc AnsiStyle
e) =
    Doc AnsiStyle
kwIf Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
cond Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
t Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwElse Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e

ppForStmt
    :: Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
ppForStmt :: Doc AnsiStyle
-> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppForStmt Doc AnsiStyle
i Doc AnsiStyle
c Doc AnsiStyle
n Doc AnsiStyle
body =
    Doc AnsiStyle
kwFor Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle
i Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
n) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body

ppWhileStmt
    :: Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
ppWhileStmt :: Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppWhileStmt Doc AnsiStyle
c Doc AnsiStyle
body =
    Doc AnsiStyle
kwWhile Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body

ppDoWhileStmt
    :: Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
ppDoWhileStmt :: Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppDoWhileStmt Doc AnsiStyle
body Doc AnsiStyle
c =
    Doc AnsiStyle
kwDo Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwWhile Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

ppSwitchStmt
    :: Doc AnsiStyle
    -> [Doc AnsiStyle]
    -> Doc AnsiStyle
ppSwitchStmt :: Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle
ppSwitchStmt Doc AnsiStyle
c [Doc AnsiStyle]
body =
    Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
        Doc AnsiStyle
kwSwitch Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
body
    ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace

ppVLA :: Pretty a => Doc AnsiStyle -> Lexeme a -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA :: Doc AnsiStyle -> Lexeme a -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA Doc AnsiStyle
ty Lexeme a
n Doc AnsiStyle
sz =
    [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"VLA("
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
ty
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
", "
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
n
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
", "
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
sz
        Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
");"

ppCompoundStmt :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCompoundStmt :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCompoundStmt [Doc AnsiStyle]
body =
    Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
        Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
body
    ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace

ppTernaryExpr
    :: Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
    -> Doc AnsiStyle
ppTernaryExpr :: Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppTernaryExpr Doc AnsiStyle
c Doc AnsiStyle
t Doc AnsiStyle
e =
    Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'?' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
t Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
colon Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e

ppLicenseDecl :: Pretty a => Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
ppLicenseDecl :: Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
ppLicenseDecl Lexeme a
l [Doc AnsiStyle]
cs =
    Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ CommentStyle -> Doc AnsiStyle
ppCommentStart CommentStyle
Regular Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"SPDX-License-Identifier: " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ((Doc AnsiStyle -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Doc AnsiStyle -> Doc AnsiStyle
dullyellow [Doc AnsiStyle]
cs) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
    Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" */")

ppIntList :: Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList :: [Lexeme a] -> Doc AnsiStyle
ppIntList = Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Lexeme a] -> Doc AnsiStyle) -> [Lexeme a] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
commaSep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Lexeme a] -> [Doc AnsiStyle]) -> [Lexeme a] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme a -> Doc AnsiStyle) -> [Lexeme a] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map (Doc AnsiStyle -> Doc AnsiStyle
dullred (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme a -> Doc AnsiStyle) -> Lexeme a -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme)

ppMacroBody :: Doc AnsiStyle -> Doc AnsiStyle
ppMacroBody :: Doc AnsiStyle -> Doc AnsiStyle
ppMacroBody =
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat
    ([Doc AnsiStyle] -> Doc AnsiStyle)
-> (Doc AnsiStyle -> [Doc AnsiStyle])
-> Doc AnsiStyle
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc AnsiStyle -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Doc AnsiStyle -> Doc AnsiStyle
dullmagenta
    ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> (Doc AnsiStyle -> [Doc AnsiStyle])
-> Doc AnsiStyle
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" \\")
    ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> (Doc AnsiStyle -> [Doc AnsiStyle])
-> Doc AnsiStyle
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Doc AnsiStyle) -> [[Char]] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty
    ([[Char]] -> [Doc AnsiStyle])
-> (Doc AnsiStyle -> [[Char]]) -> Doc AnsiStyle -> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
List.splitOn [Char]
"\n"
    ([Char] -> [[Char]])
-> (Doc AnsiStyle -> [Char]) -> Doc AnsiStyle -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Char]
renderS
    (Doc AnsiStyle -> [Char])
-> (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
forall ann xxx. Doc ann -> Doc xxx
plain

ppNode :: Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode :: Node (Lexeme a) -> Doc AnsiStyle
ppNode = (NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle)
-> Node (Lexeme a) -> Doc AnsiStyle
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
forall a.
Pretty a =>
NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
go
  where
  go :: Pretty a => NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
  go :: NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle
go = \case
    StaticAssert Doc AnsiStyle
cond Lexeme a
msg ->
        Doc AnsiStyle
kwStaticAssert Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle
cond Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
comma Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullred (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
msg)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

    LicenseDecl Lexeme a
l [Doc AnsiStyle]
cs -> Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
ppLicenseDecl Lexeme a
l [Doc AnsiStyle]
cs
    CopyrightDecl Lexeme a
from (Just Lexeme a
to) [Lexeme a]
owner ->
        [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" * Copyright © " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
from Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
to Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
        [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
ppCommentBody ((a -> Doc AnsiStyle) -> Lexeme a -> Lexeme (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Lexeme a -> Lexeme (Doc AnsiStyle))
-> [Lexeme a] -> [Lexeme (Doc AnsiStyle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme a]
owner)
    CopyrightDecl Lexeme a
from Maybe (Lexeme a)
Nothing [Lexeme a]
owner ->
        [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" * Copyright © " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
from Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
        [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle
ppCommentBody ((a -> Doc AnsiStyle) -> Lexeme a -> Lexeme (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Lexeme a -> Lexeme (Doc AnsiStyle))
-> [Lexeme a] -> [Lexeme (Doc AnsiStyle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme a]
owner)

    Comment CommentStyle
style Lexeme a
_ [Lexeme a]
cs (L AlexPosn
l LexemeClass
c a
_) ->
        CommentStyle
-> [Lexeme (Doc AnsiStyle)]
-> Lexeme (Doc AnsiStyle)
-> Doc AnsiStyle
ppComment CommentStyle
style ((a -> Doc AnsiStyle) -> Lexeme a -> Lexeme (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Lexeme a -> Lexeme (Doc AnsiStyle))
-> [Lexeme a] -> [Lexeme (Doc AnsiStyle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexeme a]
cs) (AlexPosn -> LexemeClass -> Doc AnsiStyle -> Lexeme (Doc AnsiStyle)
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
l LexemeClass
c ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*/"))
    CommentSection Doc AnsiStyle
start [Doc AnsiStyle]
decls Doc AnsiStyle
end ->
        Doc AnsiStyle
start Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
end
    CommentSectionEnd Lexeme a
cs ->
        Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
cs
    Commented Doc AnsiStyle
c Doc AnsiStyle
d ->
        Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
d
    CommentInfo Comment (Lexeme a)
docs ->
        Comment (Lexeme a) -> Doc AnsiStyle
forall a. Pretty a => Comment (Lexeme a) -> Doc AnsiStyle
ppCommentInfo Comment (Lexeme a)
docs

    VarExpr Lexeme a
var          -> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
var
    LiteralExpr LiteralType
_ Lexeme a
l      -> Doc AnsiStyle -> Doc AnsiStyle
dullred (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l
    SizeofExpr Doc AnsiStyle
arg       -> Doc AnsiStyle
kwSizeof Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
arg
    SizeofType Doc AnsiStyle
arg       -> Doc AnsiStyle
kwSizeof Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
arg
    BinaryExpr  Doc AnsiStyle
l BinaryOp
o Doc AnsiStyle
r    -> Doc AnsiStyle
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BinaryOp -> Doc AnsiStyle
ppBinaryOp BinaryOp
o Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
r
    AssignExpr  Doc AnsiStyle
l AssignOp
o Doc AnsiStyle
r    -> Doc AnsiStyle
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AssignOp -> Doc AnsiStyle
ppAssignOp AssignOp
o Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
r
    TernaryExpr Doc AnsiStyle
c Doc AnsiStyle
t Doc AnsiStyle
e    -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppTernaryExpr Doc AnsiStyle
c Doc AnsiStyle
t Doc AnsiStyle
e
    UnaryExpr UnaryOp
o Doc AnsiStyle
e        -> UnaryOp -> Doc AnsiStyle
ppUnaryOp UnaryOp
o Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
e
    ParenExpr Doc AnsiStyle
e          -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
e
    FunctionCall Doc AnsiStyle
c  [Doc AnsiStyle]
a    -> Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionCall Doc AnsiStyle
c [Doc AnsiStyle]
a
    ArrayAccess  Doc AnsiStyle
e  Doc AnsiStyle
i    -> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'[' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
i Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
']'
    CastExpr     Doc AnsiStyle
ty Doc AnsiStyle
e    -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
e
    CompoundExpr    Doc AnsiStyle
ty Doc AnsiStyle
e -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace  -- DEPRECATED
    CompoundLiteral Doc AnsiStyle
ty Doc AnsiStyle
e -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace
    PreprocDefined  Lexeme a
n    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"defined(" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
n Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
')'
    InitialiserList [Doc AnsiStyle]
l    -> [Doc AnsiStyle] -> Doc AnsiStyle
ppInitialiserList [Doc AnsiStyle]
l
    PointerAccess Doc AnsiStyle
e Lexeme a
m    -> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
m
    MemberAccess  Doc AnsiStyle
e Lexeme a
m    -> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"." Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
m
    CommentExpr   Doc AnsiStyle
c Doc AnsiStyle
e    -> Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e
    NodeF (Lexeme a) (Doc AnsiStyle)
Ellipsis             -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"..."

    VarDecl Doc AnsiStyle
ty Lexeme a
name [Doc AnsiStyle]
arrs      -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat [Doc AnsiStyle]
arrs
    DeclSpecArray Maybe (Doc AnsiStyle)
Nothing     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[]"
    DeclSpecArray (Just Doc AnsiStyle
dim)  -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
brackets Doc AnsiStyle
dim
    ArrayDim Nullability
nullability Doc AnsiStyle
size -> Nullability -> Doc AnsiStyle
ppNullability Nullability
nullability Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
size

    TyBitwise     Doc AnsiStyle
ty -> Doc AnsiStyle
kwBitwise Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
ty
    TyForce       Doc AnsiStyle
ty -> Doc AnsiStyle
kwForce Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
ty
    TyPointer     Doc AnsiStyle
ty -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'
    TyConst       Doc AnsiStyle
ty -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwConst
    TyNonnull     Doc AnsiStyle
ty -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwNonnull
    TyNullable    Doc AnsiStyle
ty -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwNullable
    TyOwner       Doc AnsiStyle
ty -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwOwner
    TyUserDefined Lexeme a
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l
    TyStd         Lexeme a
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l
    TyFunc        Lexeme a
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l
    TyStruct      Lexeme a
l  -> Doc AnsiStyle
kwStruct Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l)
    TyUnion       Lexeme a
l  -> Doc AnsiStyle
kwUnion Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l)

    ExternC [Doc AnsiStyle]
decls ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#ifdef __cplusplus") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
kwExtern Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullred ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"\"C\"") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#endif") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#ifdef __cplusplus") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
forall ann. Doc ann
rbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/* extern \"C\" */" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#endif")

    Group [Doc AnsiStyle]
decls -> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
decls

    MacroParam Lexeme a
l -> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l

    MacroBodyFunCall Doc AnsiStyle
e -> Doc AnsiStyle
e
    MacroBodyStmt Doc AnsiStyle
body ->
        Doc AnsiStyle
kwDo Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwWhile Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"(0)"

    PreprocScopedDefine Doc AnsiStyle
def [Doc AnsiStyle]
stmts Doc AnsiStyle
undef ->
        Doc AnsiStyle
def Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
stmts Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
undef

    PreprocInclude Lexeme a
hdr ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#include" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
hdr
    PreprocDefine Lexeme a
name ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#define" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name
    PreprocDefineConst Lexeme a
name Doc AnsiStyle
value ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#define" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
value
    PreprocDefineMacro Lexeme a
name [Doc AnsiStyle]
params Doc AnsiStyle
body ->
        Doc AnsiStyle -> Doc AnsiStyle
ppMacroBody (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#define" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppParamList [Doc AnsiStyle]
params Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body
    PreprocUndef Lexeme a
name ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#undef" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name

    PreprocIf Doc AnsiStyle
cond [Doc AnsiStyle]
decls Doc AnsiStyle
elseBranch ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#if" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
cond) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
elseBranch Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#endif  /*" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
cond Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*/")
    PreprocIfdef Lexeme a
name [Doc AnsiStyle]
decls Doc AnsiStyle
elseBranch ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#ifdef" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
elseBranch Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#endif  /*" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*/")
    PreprocIfndef Lexeme a
name [Doc AnsiStyle]
decls Doc AnsiStyle
elseBranch ->
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#ifndef" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
elseBranch Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#endif  /*" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*/")
    PreprocElse [] -> Doc AnsiStyle
forall a. Monoid a => a
mempty
    PreprocElse [Doc AnsiStyle]
decls ->
        Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#else") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls
    PreprocElif Doc AnsiStyle
cond [Doc AnsiStyle]
decls Doc AnsiStyle
elseBranch ->
        Doc AnsiStyle
forall ann. Doc ann
hardline Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle -> Doc AnsiStyle
dullmagenta ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#elif") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
cond Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
decls Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
        Doc AnsiStyle
elseBranch

    AttrPrintf Lexeme a
fmt Lexeme a
ellipsis Doc AnsiStyle
fun ->
        Doc AnsiStyle
kwGnuPrintf Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme a] -> Doc AnsiStyle
forall a. Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList [Lexeme a
fmt, Lexeme a
ellipsis] Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
fun
    CallbackDecl Lexeme a
ty Lexeme a
name ->
        Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name
    FunctionPrototype Doc AnsiStyle
ty Lexeme a
name [Doc AnsiStyle]
params ->
        Doc AnsiStyle -> Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
forall a.
Pretty a =>
Doc AnsiStyle -> Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionPrototype Doc AnsiStyle
ty Lexeme a
name [Doc AnsiStyle]
params
    FunctionDecl Scope
scope Doc AnsiStyle
proto ->
        Scope -> Doc AnsiStyle
ppScope Scope
scope Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
proto Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    FunctionDefn Scope
scope Doc AnsiStyle
proto Doc AnsiStyle
body ->
        Scope -> Doc AnsiStyle
ppScope Scope
scope Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
proto Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
body

    MemberDecl Doc AnsiStyle
decl Maybe (Lexeme a)
Nothing ->
        Doc AnsiStyle
decl Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    MemberDecl Doc AnsiStyle
decl (Just Lexeme a
size) ->
        Doc AnsiStyle
decl Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
colon Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
size Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

    AggregateDecl Doc AnsiStyle
struct -> Doc AnsiStyle
struct Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    Struct Lexeme a
name [Doc AnsiStyle]
members ->
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
            Doc AnsiStyle
kwStruct Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
members
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace
    Union Lexeme a
name [Doc AnsiStyle]
members ->
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
            Doc AnsiStyle
kwUnion Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
members
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace
    Typedef Doc AnsiStyle
ty Lexeme a
tyname ->
        Doc AnsiStyle
kwTypedef Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
tyname) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    TypedefFunction Doc AnsiStyle
proto ->
        Doc AnsiStyle
kwTypedef Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
proto Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

    ConstDecl Doc AnsiStyle
ty Lexeme a
name ->
        Doc AnsiStyle
kwExtern Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwConst Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    ConstDefn Scope
scope Doc AnsiStyle
ty Lexeme a
name Doc AnsiStyle
value ->
        Scope -> Doc AnsiStyle
ppScope Scope
scope Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
kwConst Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
        Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
equals Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
value Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

    Enumerator Lexeme a
name  Maybe (Doc AnsiStyle)
Nothing -> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
comma
    Enumerator Lexeme a
name (Just Doc AnsiStyle
value) ->
        Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
equals Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
value Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
comma

    EnumConsts Maybe (Lexeme a)
Nothing [Doc AnsiStyle]
enums ->
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
            Doc AnsiStyle
kwEnum Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"};"
    EnumConsts (Just Lexeme a
name) [Doc AnsiStyle]
enums ->
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
            Doc AnsiStyle
kwEnum Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"};"
    EnumDecl Lexeme a
name [Doc AnsiStyle]
enums Lexeme a
ty ->
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
indentWidth (
            Doc AnsiStyle
kwTypedef Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwEnum Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
lbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
rbrace Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
ty) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

    NonNull [] [] Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"()" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
f
    NonNull [Lexeme a]
nonnull [] Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme a] -> Doc AnsiStyle
forall a. Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList [Lexeme a]
nonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
f
    NonNull [] [Lexeme a]
nullable Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme a] -> Doc AnsiStyle
forall a. Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList [Lexeme a]
nullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
f
    NonNull [Lexeme a]
nonnull [Lexeme a]
nullable Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme a] -> Doc AnsiStyle
forall a. Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList [Lexeme a]
nonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
kwNullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme a] -> Doc AnsiStyle
forall a. Pretty a => [Lexeme a] -> Doc AnsiStyle
ppIntList [Lexeme a]
nullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
f

    NonNullParam Doc AnsiStyle
p ->
        Doc AnsiStyle
kwNonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"()" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
p
    NullableParam Doc AnsiStyle
p ->
        Doc AnsiStyle
kwNullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"()" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
p

    -- Statements
    VarDeclStmt Doc AnsiStyle
decl Maybe (Doc AnsiStyle)
Nothing      -> Doc AnsiStyle
decl Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    VarDeclStmt Doc AnsiStyle
decl (Just Doc AnsiStyle
initr) -> Doc AnsiStyle
decl Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
forall ann. Doc ann
equals Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
initr Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    Return Maybe (Doc AnsiStyle)
Nothing                -> Doc AnsiStyle
kwReturn Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    Return (Just Doc AnsiStyle
e)               -> Doc AnsiStyle
kwReturn Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    NodeF (Lexeme a) (Doc AnsiStyle)
Continue                      -> Doc AnsiStyle
kwContinue Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    NodeF (Lexeme a) (Doc AnsiStyle)
Break                         -> Doc AnsiStyle
kwBreak Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    IfStmt Doc AnsiStyle
cond Doc AnsiStyle
t Maybe (Doc AnsiStyle)
e               -> Doc AnsiStyle
-> Doc AnsiStyle -> Maybe (Doc AnsiStyle) -> Doc AnsiStyle
ppIfStmt Doc AnsiStyle
cond Doc AnsiStyle
t Maybe (Doc AnsiStyle)
e
    ForStmt Doc AnsiStyle
i Doc AnsiStyle
c Doc AnsiStyle
n Doc AnsiStyle
body            -> Doc AnsiStyle
-> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppForStmt Doc AnsiStyle
i Doc AnsiStyle
c Doc AnsiStyle
n Doc AnsiStyle
body
    Default Doc AnsiStyle
s                     -> Doc AnsiStyle
kwDefault Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
colon Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
s
    Label Lexeme a
l Doc AnsiStyle
s                     -> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent (-Int
99) (Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
colon) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
s
    ExprStmt Doc AnsiStyle
e                    -> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    Goto Lexeme a
l                        -> Doc AnsiStyle
kwGoto Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme a -> Doc AnsiStyle
forall a. Pretty a => Lexeme a -> Doc AnsiStyle
ppLexeme Lexeme a
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi
    Case Doc AnsiStyle
e Doc AnsiStyle
s                      -> Doc AnsiStyle
kwCase Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
e Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
colon Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
s
    WhileStmt Doc AnsiStyle
c Doc AnsiStyle
body              -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppWhileStmt Doc AnsiStyle
c Doc AnsiStyle
body
    DoWhileStmt Doc AnsiStyle
body Doc AnsiStyle
c            -> Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
ppDoWhileStmt Doc AnsiStyle
body Doc AnsiStyle
c
    SwitchStmt Doc AnsiStyle
c [Doc AnsiStyle]
body             -> Doc AnsiStyle -> [Doc AnsiStyle] -> Doc AnsiStyle
ppSwitchStmt Doc AnsiStyle
c [Doc AnsiStyle]
body
    CompoundStmt [Doc AnsiStyle]
body             -> [Doc AnsiStyle] -> Doc AnsiStyle
ppCompoundStmt [Doc AnsiStyle]
body
    VLA Doc AnsiStyle
ty Lexeme a
n Doc AnsiStyle
sz                   -> Doc AnsiStyle -> Lexeme a -> Doc AnsiStyle -> Doc AnsiStyle
forall a.
Pretty a =>
Doc AnsiStyle -> Lexeme a -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA Doc AnsiStyle
ty Lexeme a
n Doc AnsiStyle
sz

ppToplevel :: [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel :: [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc AnsiStyle
forall ann. Doc ann
line

ppTranslationUnit :: Pretty a => [Node (Lexeme a)] -> Doc AnsiStyle
ppTranslationUnit :: [Node (Lexeme a)] -> Doc AnsiStyle
ppTranslationUnit [Node (Lexeme a)]
decls = ([Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Node (Lexeme a)] -> [Doc AnsiStyle])
-> [Node (Lexeme a)]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme a) -> Doc AnsiStyle)
-> [Node (Lexeme a)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme a) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode ([Node (Lexeme a)] -> Doc AnsiStyle)
-> [Node (Lexeme a)] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme a)]
decls) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line

showNode  :: Pretty a => Node (Lexeme a) -> Text
showNode :: Node (Lexeme a) -> Text
showNode = Doc AnsiStyle -> Text
render (Doc AnsiStyle -> Text)
-> (Node (Lexeme a) -> Doc AnsiStyle) -> Node (Lexeme a) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node (Lexeme a) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode

showNodePlain :: Pretty a => Node (Lexeme a) -> Text
showNodePlain :: Node (Lexeme a) -> Text
showNodePlain = Doc AnsiStyle -> Text
render (Doc AnsiStyle -> Text)
-> (Node (Lexeme a) -> Doc AnsiStyle) -> Node (Lexeme a) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
forall ann xxx. Doc ann -> Doc xxx
plain (Doc AnsiStyle -> Doc AnsiStyle)
-> (Node (Lexeme a) -> Doc AnsiStyle)
-> Node (Lexeme a)
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node (Lexeme a) -> Doc AnsiStyle
forall a. Pretty a => Node (Lexeme a) -> Doc AnsiStyle
ppNode