{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE LambdaCase #-}
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 qualified Data.Text.Lazy                as TL
import           Language.Cimple               (AssignOp (..), BinaryOp (..),
                                                Comment, CommentF (..),
                                                CommentStyle (..), Lexeme (..),
                                                LexemeClass (..), Node,
                                                NodeF (..), Scope (..),
                                                UnaryOp (..), lexemeLine,
                                                lexemeText)
import           Language.Cimple.PrettyColor   (black, blue, cyan, dullcyan,
                                                dullgreen, dullmagenta, dullred,
                                                dullyellow, underline)
import           Prettyprinter
import           Prettyprinter.Render.Terminal (AnsiStyle)
import qualified Prettyprinter.Render.Terminal as Term

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

kwBitwise :: Doc AnsiStyle
kwBitwise       = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"bitwise"
kwBreak :: Doc AnsiStyle
kwBreak         = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"break"
kwCase :: Doc AnsiStyle
kwCase          = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"case"
kwConst :: Doc AnsiStyle
kwConst         = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"const"
kwContinue :: Doc AnsiStyle
kwContinue      = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"continue"
kwDefault :: Doc AnsiStyle
kwDefault       = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"default"
kwDo :: Doc AnsiStyle
kwDo            = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"do"
kwElse :: Doc AnsiStyle
kwElse          = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"else"
kwEnum :: Doc AnsiStyle
kwEnum          = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"enum"
kwExtern :: Doc AnsiStyle
kwExtern        = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"extern"
kwFor :: Doc AnsiStyle
kwFor           = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"for"
kwForce :: Doc AnsiStyle
kwForce         = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"force"
kwGnuPrintf :: Doc AnsiStyle
kwGnuPrintf     = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"GNU_PRINTF"
kwGoto :: Doc AnsiStyle
kwGoto          = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"goto"
kwIf :: Doc AnsiStyle
kwIf            = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"if"
kwNonNull :: Doc AnsiStyle
kwNonNull       = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"non_null"
kwNullable :: Doc AnsiStyle
kwNullable      = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"nullable"
kwOwner :: Doc AnsiStyle
kwOwner         = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"owner"
kwReturn :: Doc AnsiStyle
kwReturn        = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"return"
kwSizeof :: Doc AnsiStyle
kwSizeof        = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"sizeof"
kwStaticAssert :: Doc AnsiStyle
kwStaticAssert  = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"static_assert"
kwStatic :: Doc AnsiStyle
kwStatic        = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"static"
kwStruct :: Doc AnsiStyle
kwStruct        = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"struct"
kwSwitch :: Doc AnsiStyle
kwSwitch        = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"switch"
kwTypedef :: Doc AnsiStyle
kwTypedef       = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"typedef"
kwUnion :: Doc AnsiStyle
kwUnion         = Doc AnsiStyle -> Doc AnsiStyle
dullgreen (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]
"union"
kwWhile :: Doc AnsiStyle
kwWhile         = Doc AnsiStyle -> Doc AnsiStyle
dullred   (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]
"while"

kwDocAttention :: Doc AnsiStyle
kwDocAttention  = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@attention"
kwDocBrief :: Doc AnsiStyle
kwDocBrief      = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@brief"
kwDocDeprecated :: Doc AnsiStyle
kwDocDeprecated = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@deprecated"
kwDocExtends :: Doc AnsiStyle
kwDocExtends    = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@extends"
kwDocImplements :: Doc AnsiStyle
kwDocImplements = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@implements"
kwDocParam :: Doc AnsiStyle
kwDocParam      = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@param"
kwDocPrivate :: Doc AnsiStyle
kwDocPrivate    = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@private"
kwDocRef :: Doc AnsiStyle
kwDocRef        = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@ref"
kwDocReturn :: Doc AnsiStyle
kwDocReturn     = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@return"
kwDocRetval :: Doc AnsiStyle
kwDocRetval     = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@retval"
kwDocP :: Doc AnsiStyle
kwDocP          = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@p"
kwDocSee :: Doc AnsiStyle
kwDocSee        = Doc AnsiStyle -> Doc AnsiStyle
dullcyan (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]
"@see"

cmtPrefix :: Doc AnsiStyle
cmtPrefix :: Doc AnsiStyle
cmtPrefix = Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*')

ppText :: Text -> Doc AnsiStyle
ppText :: Text -> Doc AnsiStyle
ppText = [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc AnsiStyle)
-> (Text -> [Char]) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack

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

commaSep :: [Doc AnsiStyle] -> Doc AnsiStyle
commaSep :: [Doc AnsiStyle] -> Doc AnsiStyle
commaSep = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hsep ([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
comma

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

ppAssignOp :: AssignOp -> Doc AnsiStyle
ppAssignOp :: AssignOp -> Doc AnsiStyle
ppAssignOp = \case
    AssignOp
AopEq     -> Doc AnsiStyle
forall ann. Doc ann
equals
    AssignOp
AopMul    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*="
    AssignOp
AopDiv    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"/="
    AssignOp
AopPlus   -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"+="
    AssignOp
AopMinus  -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"-="
    AssignOp
AopBitAnd -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"&="
    AssignOp
AopBitOr  -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"|="
    AssignOp
AopBitXor -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"^="
    AssignOp
AopMod    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"%="
    AssignOp
AopLsh    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
">>="
    AssignOp
AopRsh    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"<<="

ppBinaryOp :: BinaryOp -> Doc AnsiStyle
ppBinaryOp :: BinaryOp -> Doc AnsiStyle
ppBinaryOp = \case
    BinaryOp
BopNe     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"!="
    BinaryOp
BopEq     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"=="
    BinaryOp
BopOr     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"||"
    BinaryOp
BopBitXor -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'^'
    BinaryOp
BopBitOr  -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'|'
    BinaryOp
BopAnd    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"&&"
    BinaryOp
BopBitAnd -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'&'
    BinaryOp
BopDiv    -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'/'
    BinaryOp
BopMul    -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'
    BinaryOp
BopMod    -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'%'
    BinaryOp
BopPlus   -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'+'
    BinaryOp
BopMinus  -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-'
    BinaryOp
BopLt     -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'<'
    BinaryOp
BopLe     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"<="
    BinaryOp
BopLsh    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"<<"
    BinaryOp
BopGt     -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'>'
    BinaryOp
BopGe     -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
">="
    BinaryOp
BopRsh    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
">>"

ppUnaryOp :: UnaryOp -> Doc AnsiStyle
ppUnaryOp :: UnaryOp -> Doc AnsiStyle
ppUnaryOp = \case
    UnaryOp
UopNot     -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'!'
    UnaryOp
UopNeg     -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'~'
    UnaryOp
UopMinus   -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-'
    UnaryOp
UopAddress -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'&'
    UnaryOp
UopDeref   -> Char -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'
    UnaryOp
UopIncr    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"++"
    UnaryOp
UopDecr    -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"--"

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 Text] -> Doc AnsiStyle
ppCommentBody :: [Lexeme Text] -> Doc AnsiStyle
ppCommentBody [Lexeme Text]
body = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Lexeme Text] -> [Doc AnsiStyle])
-> [Lexeme Text]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> [Doc AnsiStyle]
prefixStars ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> ([Lexeme Text] -> [Doc AnsiStyle])
-> [Lexeme Text]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Lexeme Text] -> Doc AnsiStyle)
-> [[Lexeme Text]] -> [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 Text] -> [Doc AnsiStyle])
-> [Lexeme Text]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme Text -> Doc AnsiStyle) -> [Lexeme Text] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme Text -> Doc AnsiStyle
ppWord ([Lexeme Text] -> [Doc AnsiStyle])
-> ([Lexeme Text] -> [Lexeme Text])
-> [Lexeme Text]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme Text] -> [Lexeme Text]
spaceWords) ([[Lexeme Text]] -> [Doc AnsiStyle])
-> ([Lexeme Text] -> [[Lexeme Text]])
-> [Lexeme Text]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lexeme Text] -> [[Lexeme Text]]
forall text. [Lexeme text] -> [[Lexeme text]]
groupLines ([Lexeme Text] -> Doc AnsiStyle) -> [Lexeme Text] -> Doc AnsiStyle
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 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
tSpaceText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s)Lexeme Text -> [Lexeme Text] -> [Lexeme Text]
forall a. a -> [a] -> [a]
:[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
tSpaceText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
sText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
tSpace), 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
tSpaceText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s)Lexeme 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
tSpaceText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
s)Lexeme Text -> [Lexeme Text] -> [Lexeme Text]
forall a. a -> [a] -> [a]
:[Lexeme Text] -> [Lexeme Text]
continue [Lexeme Text]
ws

        tSpace :: Text
        tSpace :: Text
tSpace = [Char] -> Text
Text.pack [Char]
" "

ppWord :: Lexeme Text -> Doc AnsiStyle
ppWord (L AlexPosn
_ LexemeClass
CmtIndent  Text
_) = Doc AnsiStyle
forall a. Monoid a => a
mempty
ppWord (L AlexPosn
_ LexemeClass
CmtCommand Text
t) = Doc AnsiStyle -> Doc AnsiStyle
dullcyan   (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Text -> Doc AnsiStyle
ppText Text
t
ppWord (L AlexPosn
_ LexemeClass
_          Text
t) = Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Text -> Doc AnsiStyle
ppText Text
t

ppComment :: CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc AnsiStyle
ppComment :: CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc AnsiStyle
ppComment CommentStyle
Ignore [Lexeme Text]
cs Lexeme Text
_ =
    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 Text -> Doc AnsiStyle) -> [Lexeme Text] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Lexeme Text -> Doc AnsiStyle
ppWord [Lexeme Text]
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 Text]
cs (L AlexPosn
l LexemeClass
c Text
_) =
    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 Text] -> Doc AnsiStyle
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 ([Char] -> Text
Text.pack [Char]
"*/")])

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
    :: Doc AnsiStyle
    -> Lexeme Text
    -> [Doc AnsiStyle]
    -> Doc AnsiStyle
ppFunctionPrototype :: Doc AnsiStyle -> Lexeme Text -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionPrototype Doc AnsiStyle
ty Lexeme Text
name [Doc AnsiStyle]
params =
    Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
body
    ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
forall ann. Doc ann
rbrace

ppVLA :: Doc AnsiStyle -> Lexeme Text -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA :: Doc AnsiStyle -> Lexeme Text -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA Doc AnsiStyle
ty Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
body
    ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> 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 :: Lexeme Text -> [Doc AnsiStyle] -> Doc AnsiStyle
ppLicenseDecl :: Lexeme Text -> [Doc AnsiStyle] -> Doc AnsiStyle
ppLicenseDecl Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
l Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$>
    [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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
    Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" */")

ppIntList :: [Lexeme Text] -> Doc AnsiStyle
ppIntList :: [Lexeme Text] -> Doc AnsiStyle
ppIntList = Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Lexeme Text] -> Doc AnsiStyle)
-> [Lexeme Text]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
commaSep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Lexeme Text] -> [Doc AnsiStyle])
-> [Lexeme Text]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexeme Text -> Doc AnsiStyle) -> [Lexeme Text] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map (Doc AnsiStyle -> Doc AnsiStyle
dullred (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme Text -> Doc AnsiStyle) -> Lexeme Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> 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

plain :: Doc ann -> Doc xxx
plain :: Doc ann -> Doc xxx
plain = Doc ann -> Doc xxx
forall ann xxx. Doc ann -> Doc xxx
unAnnotate

ppVerbatimComment :: Doc AnsiStyle -> Doc AnsiStyle
ppVerbatimComment :: Doc AnsiStyle -> Doc AnsiStyle
ppVerbatimComment =
    [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
dullyellow
    ([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] -> [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]
: Doc AnsiStyle -> [Doc AnsiStyle]
forall a. a -> [a]
repeat ([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

ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody =
    [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] -> [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]
: [Char] -> [Doc AnsiStyle]
commentStart [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
    (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
forall ann. [Doc ann] -> Doc ann
hcat

commentStart :: String -> [Doc AnsiStyle]
commentStart :: [Char] -> [Doc AnsiStyle]
commentStart = Doc AnsiStyle -> [Doc AnsiStyle]
forall a. a -> [a]
repeat (Doc AnsiStyle -> [Doc AnsiStyle])
-> ([Char] -> Doc AnsiStyle) -> [Char] -> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle)
-> ([Char] -> Doc AnsiStyle) -> [Char] -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty

ppCommentInfo :: Comment (Lexeme Text) -> Doc AnsiStyle
ppCommentInfo :: Comment (Lexeme Text) -> Doc AnsiStyle
ppCommentInfo = (CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle)
-> Comment (Lexeme Text) -> Doc AnsiStyle
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
go
  where
  ppBody :: [Doc AnsiStyle] -> Doc AnsiStyle
ppBody     = [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] -> [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
(<>) (        [Char] -> [Doc AnsiStyle]
commentStart [Char]
" * "  )
  ppIndented :: [Doc AnsiStyle] -> Doc AnsiStyle
ppIndented = [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] -> [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]
: [Char] -> [Doc AnsiStyle]
commentStart [Char]
" *   ")
  ppRef :: Lexeme Text -> Doc AnsiStyle
ppRef      = Doc AnsiStyle -> Doc AnsiStyle
underline (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme Text -> Doc AnsiStyle) -> Lexeme Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Doc AnsiStyle
cyan (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme Text -> Doc AnsiStyle) -> Lexeme Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Doc AnsiStyle
ppLexeme
  ppAttr :: Maybe (Lexeme Text) -> Doc AnsiStyle
ppAttr     = Doc AnsiStyle
-> (Lexeme Text -> Doc AnsiStyle)
-> Maybe (Lexeme Text)
-> Doc AnsiStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc AnsiStyle
forall a. Monoid a => a
mempty (Doc AnsiStyle -> Doc AnsiStyle
blue (Doc AnsiStyle -> Doc AnsiStyle)
-> (Lexeme Text -> Doc AnsiStyle) -> Lexeme Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Text -> Doc AnsiStyle
ppLexeme)

  go :: CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
  go :: CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
go = Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle)
-> (CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle)
-> CommentF (Lexeme Text) (Doc AnsiStyle)
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    DocComment [Doc AnsiStyle]
docs ->
        [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] -> Doc AnsiStyle
ppBody [Doc AnsiStyle]
docs Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$>
        Doc AnsiStyle -> Doc AnsiStyle
dullyellow ([Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
" */")
    DocWord Lexeme Text
w -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
w
    DocSentence [Doc AnsiStyle]
docs Lexeme Text
ending -> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
fillSep [Doc AnsiStyle]
docs Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
ending
    CommentF (Lexeme Text) (Doc AnsiStyle)
DocNewline -> Doc AnsiStyle
forall a. Monoid a => a
mempty

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

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

    DocParagraph [Doc AnsiStyle]
docs -> [Doc AnsiStyle] -> Doc AnsiStyle
ppIndented [Doc AnsiStyle]
docs
    DocLine [Doc AnsiStyle]
docs -> [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
fillSep [Doc AnsiStyle]
docs
    DocCode Lexeme Text
begin [Doc AnsiStyle]
code Lexeme Text
end -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
begin Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Doc AnsiStyle] -> Doc AnsiStyle
ppCodeBody [Doc AnsiStyle]
code Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
end
    DocList [Doc AnsiStyle]
l -> Doc AnsiStyle -> Doc AnsiStyle
ppVerbatimComment (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
l
    DocOLItem Lexeme Text
num [Doc AnsiStyle]
docs -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
num 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
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
3 ([Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
fillSep [Doc AnsiStyle]
docs)
    DocULItem [Doc AnsiStyle]
docs [Doc AnsiStyle]
sublist -> 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
<+> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
fillSep [Doc AnsiStyle]
docs Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
: [Doc AnsiStyle]
sublist)

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

ppNode :: Node (Lexeme Text) -> Doc AnsiStyle
ppNode :: Node (Lexeme Text) -> Doc AnsiStyle
ppNode = (NodeF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle)
-> Node (Lexeme Text) -> Doc AnsiStyle
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
go
  where
  go :: NodeF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
  go :: NodeF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle
go = \case
    StaticAssert Doc AnsiStyle
cond Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
msg)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
semi

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

    Comment CommentStyle
style Lexeme Text
_ [Lexeme Text]
cs Lexeme Text
end ->
        CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc AnsiStyle
ppComment CommentStyle
style [Lexeme Text]
cs Lexeme Text
end
    CommentSection Doc AnsiStyle
start [Doc AnsiStyle]
decls Doc AnsiStyle
end ->
        Doc AnsiStyle
start Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> 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 ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
end
    CommentSectionEnd Lexeme Text
cs ->
        Doc AnsiStyle -> Doc AnsiStyle
dullyellow (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
cs
    Commented Doc AnsiStyle
c Doc AnsiStyle
d ->
        Doc AnsiStyle
c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
d
    CommentInfo Comment (Lexeme Text)
docs ->
        Comment (Lexeme Text) -> Doc AnsiStyle
ppCommentInfo Comment (Lexeme Text)
docs

    VarExpr Lexeme Text
var          -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
var
    LiteralExpr LiteralType
_ Lexeme Text
l      -> Doc AnsiStyle -> Doc AnsiStyle
dullred (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
m
    MemberAccess  Doc AnsiStyle
e Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text) (Doc AnsiStyle)
Ellipsis             -> [Char] -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"..."

    VarDecl Doc AnsiStyle
ty Lexeme Text
name [Doc AnsiStyle]
arrs      -> Doc AnsiStyle
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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

    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
    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 Text
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
l
    TyStd         Lexeme Text
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
l
    TyFunc        Lexeme Text
l  -> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
l
    TyStruct      Lexeme Text
l  -> Doc AnsiStyle
kwStruct Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
dullgreen (Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 Text
l -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$> [Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel [Doc AnsiStyle]
stmts Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
undef

    PreprocInclude Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
hdr
    PreprocDefine Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name
    PreprocDefineConst Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
value
    PreprocDefineMacro Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
        [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 Text
fmt Lexeme Text
ellipsis Doc AnsiStyle
fun ->
        Doc AnsiStyle
kwGnuPrintf Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc AnsiStyle
ppIntList [Lexeme Text
fmt, Lexeme Text
ellipsis] Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
fun
    CallbackDecl Lexeme Text
ty Lexeme Text
name ->
        Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
ty Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name
    FunctionPrototype Doc AnsiStyle
ty Lexeme Text
name [Doc AnsiStyle]
params ->
        Doc AnsiStyle -> Lexeme Text -> [Doc AnsiStyle] -> Doc AnsiStyle
ppFunctionPrototype Doc AnsiStyle
ty Lexeme Text
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 Text)
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
members
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
forall ann. Doc ann
rbrace
    Union Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
members
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
forall ann. Doc ann
rbrace
    Typedef Doc AnsiStyle
ty Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
name  Maybe (Doc AnsiStyle)
Nothing -> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
name Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
comma
    Enumerator Lexeme Text
name (Just Doc AnsiStyle
value) ->
        Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text)
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) 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]
"};"
    EnumConsts (Just Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) 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]
"};"
    EnumDecl Lexeme Text
name [Doc AnsiStyle]
enums Lexeme Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$>
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
enums
        ) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> 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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
f
    NonNull [Lexeme Text]
nonnull [] Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNonNull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc AnsiStyle
ppIntList [Lexeme Text]
nonnull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
f
    NonNull [] [Lexeme Text]
nullable Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc AnsiStyle
ppIntList [Lexeme Text]
nullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
f
    NonNull [Lexeme Text]
nonnull [Lexeme Text]
nullable Doc AnsiStyle
f ->
        Doc AnsiStyle
kwNonNull Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> [Lexeme Text] -> Doc AnsiStyle
ppIntList [Lexeme Text]
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 Text] -> Doc AnsiStyle
ppIntList [Lexeme Text]
nullable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<$$> Doc AnsiStyle
f

    -- 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 Text) (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 Text) (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 Text
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 Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 ann. Doc ann -> Doc ann -> Doc ann
<$$> 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 Text
l                        -> Doc AnsiStyle
kwGoto Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lexeme Text -> Doc AnsiStyle
ppLexeme Lexeme Text
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 Text
n Doc AnsiStyle
sz                   -> Doc AnsiStyle -> Lexeme Text -> Doc AnsiStyle -> Doc AnsiStyle
ppVLA Doc AnsiStyle
ty Lexeme Text
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 :: [Node (Lexeme Text)] -> Doc AnsiStyle
ppTranslationUnit :: [Node (Lexeme Text)] -> Doc AnsiStyle
ppTranslationUnit [Node (Lexeme Text)]
decls = ([Doc AnsiStyle] -> Doc AnsiStyle
ppToplevel ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Node (Lexeme Text)] -> [Doc AnsiStyle])
-> [Node (Lexeme Text)]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node (Lexeme Text) -> Doc AnsiStyle)
-> [Node (Lexeme Text)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map Node (Lexeme Text) -> Doc AnsiStyle
ppNode ([Node (Lexeme Text)] -> Doc AnsiStyle)
-> [Node (Lexeme Text)] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Node (Lexeme Text)]
decls) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line

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

renderSmart :: Float -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
renderSmart :: Float -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
renderSmart Float
ribbonFraction Int
widthPerLine
    = LayoutOptions -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions :: PageWidth -> LayoutOptions
LayoutOptions
        { layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
widthPerLine (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ribbonFraction) }

renderS :: Doc AnsiStyle -> String
renderS :: Doc AnsiStyle -> [Char]
renderS = Text -> [Char]
Text.unpack (Text -> [Char])
-> (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Text
render

render :: Doc AnsiStyle -> Text
render :: Doc AnsiStyle -> Text
render = Text -> Text
TL.toStrict (Text -> Text) -> (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream AnsiStyle -> Text
Term.renderLazy (SimpleDocStream AnsiStyle -> Text)
-> (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
renderSmart Float
1 Int
120

infixr 5 <$$>
(<$$>) :: Doc a -> Doc a -> Doc a
Doc a
x <$$> :: Doc a -> Doc a -> Doc a
<$$> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y