{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.GLSL.Pretty where

import Text.PrettyPrint.HughesPJClass
import Text.Printf

import Language.GLSL.Syntax
import Prelude hiding ((<>))

----------------------------------------------------------------------
-- helpers (TODO clean)
----------------------------------------------------------------------

type Assoc = (Rational -> Rational, Rational -> Rational)

assocLeft, assocRight, assocNone :: Assoc
assocLeft :: Assoc
assocLeft  = (Rational -> Rational
forall a. a -> a
id,Rational -> Rational
bump)
assocRight :: Assoc
assocRight = (Rational -> Rational
bump,Rational -> Rational
forall a. a -> a
id)
assocNone :: Assoc
assocNone  = (Rational -> Rational
bump,Rational -> Rational
bump)

bump :: Rational -> Rational
bump :: Rational -> Rational
bump = (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
0.5)

prettyBinary :: Pretty a =>
  PrettyLevel -> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary :: forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
op (Rational -> Rational
lf,Rational -> Rational
rf) String
o a
e1 a
e2 = Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
op) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
  PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Rational -> Rational
lf Rational
op) a
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
o Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Rational -> Rational
rf Rational
op) a
e2

option :: Pretty a => Maybe a -> Doc
option :: forall a. Pretty a => Maybe a -> Doc
option Maybe a
Nothing = Doc
empty
option (Just a
x) = a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
x

indexing :: Pretty a => Maybe (Maybe a) -> Doc
indexing :: forall a. Pretty a => Maybe (Maybe a) -> Doc
indexing Maybe (Maybe a)
Nothing = Doc
empty
indexing (Just Maybe a
Nothing) = Doc -> Doc
brackets Doc
empty
indexing (Just (Just a
e)) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
e

indexing' :: Pretty a => Maybe (String, Maybe a) -> Doc
indexing' :: forall a. Pretty a => Maybe (String, Maybe a) -> Doc
indexing' Maybe (String, Maybe a)
Nothing = Doc
empty
indexing' (Just (String
i, Maybe a
Nothing)) = String -> Doc
text String
i
indexing' (Just (String
i, Just a
e)) = String -> Doc
text String
i Doc -> Doc -> Doc
<> Doc -> Doc
brackets (a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
e)

initialize :: Pretty a => Maybe a -> Doc
initialize :: forall a. Pretty a => Maybe a -> Doc
initialize Maybe a
Nothing = Doc
empty
initialize (Just a
e) = Char -> Doc
char Char
' ' Doc -> Doc -> Doc
<> Doc
equals Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
e

ident :: Pretty a => Maybe (String, Maybe (Maybe a)) -> Doc
ident :: forall a. Pretty a => Maybe (String, Maybe (Maybe a)) -> Doc
ident Maybe (String, Maybe (Maybe a))
Nothing = Doc
empty
ident (Just (String
i, Maybe (Maybe a)
Nothing)) = String -> Doc
text String
i
ident (Just (String
i, Just Maybe a
Nothing)) = String -> Doc
text String
i Doc -> Doc -> Doc
<> Doc -> Doc
brackets Doc
empty
ident (Just (String
i, Just (Just a
e))) = String -> Doc
text String
i Doc -> Doc -> Doc
<> Doc -> Doc
brackets (a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
e)

initialize' :: Pretty a => Maybe (String, Maybe a) -> Doc
initialize' :: forall a. Pretty a => Maybe (String, Maybe a) -> Doc
initialize' Maybe (String, Maybe a)
Nothing = Doc
empty
initialize' (Just (String
i, Maybe a
Nothing)) = String -> Doc
text String
i
initialize' (Just (String
i, Just a
e)) = String -> Doc
text String
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
e

----------------------------------------------------------------------
-- Pretty instances
----------------------------------------------------------------------

instance Pretty TranslationUnit where
  pPrint :: TranslationUnit -> Doc
pPrint (TranslationUnit [ExternalDeclaration]
ds) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ExternalDeclaration -> Doc) -> [ExternalDeclaration] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExternalDeclaration -> Doc
forall a. Pretty a => a -> Doc
pPrint [ExternalDeclaration]
ds
--  pPrint (Alternative p e) = text "(" <> nest 2 (vcat [pPrint p, pPrint e]) <> text ")"

instance Pretty ExternalDeclaration where
  pPrint :: ExternalDeclaration -> Doc
pPrint (FunctionDeclaration FunctionPrototype
p) = FunctionPrototype -> Doc
forall a. Pretty a => a -> Doc
pPrint FunctionPrototype
p Doc -> Doc -> Doc
<> Doc
semi
  pPrint (FunctionDefinition FunctionPrototype
p Compound
s) = [Doc] -> Doc
vcat [FunctionPrototype -> Doc
forall a. Pretty a => a -> Doc
pPrint FunctionPrototype
p, Compound -> Doc
forall a. Pretty a => a -> Doc
pPrint Compound
s]
  pPrint (Declaration Declaration
d) = Declaration -> Doc
forall a. Pretty a => a -> Doc
pPrint Declaration
d

instance Pretty Declaration where
  pPrint :: Declaration -> Doc
pPrint (InitDeclaration InvariantOrType
it [InitDeclarator]
ds) = InvariantOrType -> Doc
forall a. Pretty a => a -> Doc
pPrint InvariantOrType
it Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((InitDeclarator -> Doc) -> [InitDeclarator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InitDeclarator -> Doc
forall a. Pretty a => a -> Doc
pPrint [InitDeclarator]
ds)) Doc -> Doc -> Doc
<> Doc
semi
  pPrint (Precision PrecisionQualifier
pq TypeSpecifierNoPrecision
t) = String -> Doc
text String
"precision" Doc -> Doc -> Doc
<+> PrecisionQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint PrecisionQualifier
pq Doc -> Doc -> Doc
<+> TypeSpecifierNoPrecision -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifierNoPrecision
t Doc -> Doc -> Doc
<> Doc
semi
  pPrint (Block TypeQualifier
tq String
i [Field]
ds Maybe (String, Maybe (Maybe Expr))
n) = [Doc] -> Doc
vcat [TypeQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeQualifier
tq Doc -> Doc -> Doc
<+> String -> Doc
text String
i, Doc
lbrace, Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Field -> Doc) -> [Field] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field -> Doc
forall a. Pretty a => a -> Doc
pPrint [Field]
ds), Doc
rbrace Doc -> Doc -> Doc
<+> Maybe (String, Maybe (Maybe Expr)) -> Doc
forall a. Pretty a => Maybe (String, Maybe (Maybe a)) -> Doc
ident Maybe (String, Maybe (Maybe Expr))
n Doc -> Doc -> Doc
<> Doc
semi]
  pPrint (TQ TypeQualifier
tq) = TypeQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeQualifier
tq Doc -> Doc -> Doc
<> Doc
semi

instance Pretty InitDeclarator where
  pPrint :: InitDeclarator -> Doc
pPrint (InitDecl String
i Maybe (Maybe Expr)
a Maybe Expr
b) = String -> Doc
text String
i Doc -> Doc -> Doc
<> Maybe (Maybe Expr) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
indexing Maybe (Maybe Expr)
a Doc -> Doc -> Doc
<> Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
initialize Maybe Expr
b

instance Pretty InvariantOrType where
  pPrint :: InvariantOrType -> Doc
pPrint InvariantOrType
InvariantDeclarator = String -> Doc
text String
"invariant"
  pPrint (TypeDeclarator FullType
ft) = FullType -> Doc
forall a. Pretty a => a -> Doc
pPrint FullType
ft

instance Pretty FullType where
  pPrint :: FullType -> Doc
pPrint (FullType Maybe TypeQualifier
tq TypeSpecifier
ts) = Maybe TypeQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe TypeQualifier
tq Doc -> Doc -> Doc
<+> TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifier
ts

instance Pretty TypeQualifier where
  pPrint :: TypeQualifier -> Doc
pPrint (TypeQualSto StorageQualifier
sq) = StorageQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint StorageQualifier
sq
  pPrint (TypeQualLay LayoutQualifier
lq Maybe StorageQualifier
sq) = LayoutQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint LayoutQualifier
lq Doc -> Doc -> Doc
<+> Maybe StorageQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe StorageQualifier
sq
  pPrint (TypeQualInt InterpolationQualifier
iq Maybe StorageQualifier
sq) = InterpolationQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint InterpolationQualifier
iq Doc -> Doc -> Doc
<+> Maybe StorageQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe StorageQualifier
sq
  pPrint (TypeQualInv InvariantQualifier
iq Maybe StorageQualifier
sq) = InvariantQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint InvariantQualifier
iq Doc -> Doc -> Doc
<+> Maybe StorageQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe StorageQualifier
sq
  pPrint (TypeQualInv3 InvariantQualifier
iq InterpolationQualifier
iq' StorageQualifier
sq) = InvariantQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint InvariantQualifier
iq Doc -> Doc -> Doc
<+> InterpolationQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint InterpolationQualifier
iq' Doc -> Doc -> Doc
<+> StorageQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint StorageQualifier
sq

instance Pretty StorageQualifier where
  pPrint :: StorageQualifier -> Doc
pPrint StorageQualifier
q = case StorageQualifier
q of
    StorageQualifier
Const -> String -> Doc
text String
"const"
    StorageQualifier
Attribute -> String -> Doc
text String
"attribute"
    StorageQualifier
Varying -> String -> Doc
text String
"varying"
    StorageQualifier
CentroidVarying -> String -> Doc
text String
"centroid varying"
    StorageQualifier
In -> String -> Doc
text String
"in"
    StorageQualifier
Out -> String -> Doc
text String
"out"
    StorageQualifier
CentroidIn -> String -> Doc
text String
"centroid in"
    StorageQualifier
CentroidOut -> String -> Doc
text String
"centroid out"
    StorageQualifier
Uniform -> String -> Doc
text String
"uniform"

instance Pretty LayoutQualifier where
  pPrint :: LayoutQualifier -> Doc
pPrint (Layout [LayoutQualifierId]
is) = String -> Doc
text String
"layout" Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<>
    ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (LayoutQualifierId -> Doc) -> [LayoutQualifierId] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LayoutQualifierId -> Doc
forall a. Pretty a => a -> Doc
pPrint [LayoutQualifierId]
is) Doc -> Doc -> Doc
<> Char -> Doc
char Char
')'

instance Pretty LayoutQualifierId where
  pPrint :: LayoutQualifierId -> Doc
pPrint (LayoutQualId String
i Maybe Expr
Nothing) = String -> Doc
text String
i
  pPrint (LayoutQualId String
i (Just Expr
e)) = String -> Doc
text String
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e

instance Pretty InterpolationQualifier where
  pPrint :: InterpolationQualifier -> Doc
pPrint InterpolationQualifier
q = case InterpolationQualifier
q of
    InterpolationQualifier
Smooth -> String -> Doc
text String
"smooth"
    InterpolationQualifier
Flat -> String -> Doc
text String
"flat"
    InterpolationQualifier
NoPerspective -> String -> Doc
text String
"noperspective"

instance Pretty InvariantQualifier where
  pPrint :: InvariantQualifier -> Doc
pPrint InvariantQualifier
Invariant = String -> Doc
text String
"invariant"

instance Pretty TypeSpecifier where
  pPrint :: TypeSpecifier -> Doc
pPrint (TypeSpec (Just PrecisionQualifier
pq) TypeSpecifierNoPrecision
t) = PrecisionQualifier -> Doc
forall a. Pretty a => a -> Doc
pPrint PrecisionQualifier
pq Doc -> Doc -> Doc
<+> TypeSpecifierNoPrecision -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifierNoPrecision
t
  pPrint (TypeSpec Maybe PrecisionQualifier
Nothing TypeSpecifierNoPrecision
t) = TypeSpecifierNoPrecision -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifierNoPrecision
t

instance Pretty PrecisionQualifier where
  pPrint :: PrecisionQualifier -> Doc
pPrint PrecisionQualifier
HighP = String -> Doc
text String
"highp"
  pPrint PrecisionQualifier
MediumP = String -> Doc
text String
"mediump"
  pPrint PrecisionQualifier
LowP = String -> Doc
text String
"lowp"

instance Pretty TypeSpecifierNoPrecision where
  pPrint :: TypeSpecifierNoPrecision -> Doc
pPrint (TypeSpecNoPrecision TypeSpecifierNonArray
t Maybe (Maybe Expr)
a) = TypeSpecifierNonArray -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifierNonArray
t Doc -> Doc -> Doc
<+> Maybe (Maybe Expr) -> Doc
forall a. Pretty a => Maybe (Maybe a) -> Doc
indexing Maybe (Maybe Expr)
a

instance Pretty TypeSpecifierNonArray where
  pPrint :: TypeSpecifierNonArray -> Doc
pPrint TypeSpecifierNonArray
t = case TypeSpecifierNonArray
t of
    TypeSpecifierNonArray
Void -> String -> Doc
text String
"void"
    TypeSpecifierNonArray
Float -> String -> Doc
text String
"float"
    TypeSpecifierNonArray
Int -> String -> Doc
text String
"int"
    TypeSpecifierNonArray
UInt -> String -> Doc
text String
"uint"
    TypeSpecifierNonArray
Bool -> String -> Doc
text String
"bool"
    TypeSpecifierNonArray
Vec2 -> String -> Doc
text String
"vec2"
    TypeSpecifierNonArray
Vec3 -> String -> Doc
text String
"vec3"
    TypeSpecifierNonArray
Vec4 -> String -> Doc
text String
"vec4"
    TypeSpecifierNonArray
BVec2 -> String -> Doc
text String
"bvec2"
    TypeSpecifierNonArray
BVec3 -> String -> Doc
text String
"bvec3"
    TypeSpecifierNonArray
BVec4 -> String -> Doc
text String
"bvec4"
    TypeSpecifierNonArray
IVec2 -> String -> Doc
text String
"ivec2"
    TypeSpecifierNonArray
IVec3 -> String -> Doc
text String
"ivec3"
    TypeSpecifierNonArray
IVec4 -> String -> Doc
text String
"ivec4"
    TypeSpecifierNonArray
UVec2 -> String -> Doc
text String
"uvec2"
    TypeSpecifierNonArray
UVec3 -> String -> Doc
text String
"uvec3"
    TypeSpecifierNonArray
UVec4 -> String -> Doc
text String
"uvec4"
    TypeSpecifierNonArray
Mat2 -> String -> Doc
text String
"mat2"
    TypeSpecifierNonArray
Mat3 -> String -> Doc
text String
"mat3"
    TypeSpecifierNonArray
Mat4 -> String -> Doc
text String
"mat4"
    TypeSpecifierNonArray
Mat2x2 -> String -> Doc
text String
"mat2x2"
    TypeSpecifierNonArray
Mat2x3 -> String -> Doc
text String
"mat2x3"
    TypeSpecifierNonArray
Mat2x4 -> String -> Doc
text String
"mat2x4"
    TypeSpecifierNonArray
Mat3x2 -> String -> Doc
text String
"mat3x2"
    TypeSpecifierNonArray
Mat3x3 -> String -> Doc
text String
"mat3x3"
    TypeSpecifierNonArray
Mat3x4 -> String -> Doc
text String
"mat3x4"
    TypeSpecifierNonArray
Mat4x2 -> String -> Doc
text String
"mat4x2"
    TypeSpecifierNonArray
Mat4x3 -> String -> Doc
text String
"mat4x3"
    TypeSpecifierNonArray
Mat4x4 -> String -> Doc
text String
"mat4x4"
    TypeSpecifierNonArray
Sampler1D -> String -> Doc
text String
"sampler1D"
    TypeSpecifierNonArray
Sampler2D -> String -> Doc
text String
"sampler2D"
    TypeSpecifierNonArray
Sampler3D -> String -> Doc
text String
"sampler3D"
    TypeSpecifierNonArray
SamplerCube -> String -> Doc
text String
"samplerCube"
    TypeSpecifierNonArray
Sampler1DShadow -> String -> Doc
text String
"sampler1DShadow"
    TypeSpecifierNonArray
Sampler2DShadow -> String -> Doc
text String
"sampler2DShadow"
    TypeSpecifierNonArray
SamplerCubeShadow -> String -> Doc
text String
"samplerCubeShadow"
    TypeSpecifierNonArray
Sampler1DArray -> String -> Doc
text String
"sampler1DArray"
    TypeSpecifierNonArray
Sampler2DArray -> String -> Doc
text String
"sampler2DArray"
    TypeSpecifierNonArray
Sampler1DArrayShadow -> String -> Doc
text String
"sampler1DArrayShadow"
    TypeSpecifierNonArray
Sampler2DArrayShadow -> String -> Doc
text String
"sampler2DArrayShadow"
    TypeSpecifierNonArray
ISampler1D -> String -> Doc
text String
"isampler1D"
    TypeSpecifierNonArray
ISampler2D -> String -> Doc
text String
"isampler2D"
    TypeSpecifierNonArray
ISampler3D -> String -> Doc
text String
"isampler3D"
    TypeSpecifierNonArray
ISamplerCube -> String -> Doc
text String
"isamplerCube"
    TypeSpecifierNonArray
ISampler1DArray -> String -> Doc
text String
"isampler1DArray"
    TypeSpecifierNonArray
ISampler2DArray -> String -> Doc
text String
"isampler2DArray"
    TypeSpecifierNonArray
USampler1D -> String -> Doc
text String
"usampler1D"
    TypeSpecifierNonArray
USampler2D -> String -> Doc
text String
"usampler2D"
    TypeSpecifierNonArray
USampler3D -> String -> Doc
text String
"usampler3D"
    TypeSpecifierNonArray
USamplerCube -> String -> Doc
text String
"usamplerCube"
    TypeSpecifierNonArray
USampler1DArray -> String -> Doc
text String
"usampler1DArray"
    TypeSpecifierNonArray
USampler2DArray -> String -> Doc
text String
"usampler2DArray"
    TypeSpecifierNonArray
Sampler2DRect -> String -> Doc
text String
"sampler2DRect"
    TypeSpecifierNonArray
Sampler2DRectShadow -> String -> Doc
text String
"sampler2DRectShadow"
    TypeSpecifierNonArray
ISampler2DRect -> String -> Doc
text String
"isampler2DRect"
    TypeSpecifierNonArray
USampler2DRect -> String -> Doc
text String
"usampler2DRect"
    TypeSpecifierNonArray
SamplerBuffer -> String -> Doc
text String
"samplerBuffer"
    TypeSpecifierNonArray
ISamplerBuffer -> String -> Doc
text String
"isamplerBuffer"
    TypeSpecifierNonArray
USamplerBuffer -> String -> Doc
text String
"usamplerBuffer"
    TypeSpecifierNonArray
Sampler2DMS -> String -> Doc
text String
"sampler2DMS"
    TypeSpecifierNonArray
ISampler2DMS -> String -> Doc
text String
"isampler2DMS"
    TypeSpecifierNonArray
USampler2DMS -> String -> Doc
text String
"usampler2DMS"
    TypeSpecifierNonArray
Sampler2DMSArray -> String -> Doc
text String
"sampler2DMSArray"
    TypeSpecifierNonArray
ISampler2DMSArray -> String -> Doc
text String
"isampler2DMSArray"
    TypeSpecifierNonArray
USampler2DMSArray -> String -> Doc
text String
"usampler2DMSArray"
    StructSpecifier Maybe String
i [Field]
ds ->
      [Doc] -> Doc
vcat [String -> Doc
text String
"struct" Doc -> Doc -> Doc
<+> Doc
i', Doc
lbrace, Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Field -> Doc) -> [Field] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Field -> Doc
forall a. Pretty a => a -> Doc
pPrint [Field]
ds), Doc
rbrace]
      where i' :: Doc
i' = case Maybe String
i of { Maybe String
Nothing -> Doc
empty ; Just String
n -> String -> Doc
text String
n }
    TypeName String
i -> String -> Doc
text String
i

instance Pretty Field where
  pPrint :: Field -> Doc
pPrint (Field Maybe TypeQualifier
tq TypeSpecifier
s [StructDeclarator]
ds) =
    Maybe TypeQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe TypeQualifier
tq Doc -> Doc -> Doc
<+> TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifier
s Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (StructDeclarator -> Doc) -> [StructDeclarator] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map StructDeclarator -> Doc
forall a. Pretty a => a -> Doc
pPrint [StructDeclarator]
ds) Doc -> Doc -> Doc
<> Doc
semi

instance Pretty StructDeclarator where
  pPrint :: StructDeclarator -> Doc
pPrint (StructDeclarator String
i Maybe (Maybe Expr)
e) = Maybe (String, Maybe (Maybe Expr)) -> Doc
forall a. Pretty a => Maybe (String, Maybe (Maybe a)) -> Doc
ident ((String, Maybe (Maybe Expr)) -> Maybe (String, Maybe (Maybe Expr))
forall a. a -> Maybe a
Just (String
i, Maybe (Maybe Expr)
e))

instance Pretty Expr where
  pPrintPrec :: PrettyLevel -> Rational -> Expr -> Doc
pPrintPrec PrettyLevel
l Rational
p Expr
e = case Expr
e of
  -- primaryExpression
    Variable String
v -> String -> Doc
text String
v
    IntConstant IntConstantKind
Decimal Integer
i -> String -> Doc
text (Integer -> String
forall a. Show a => a -> String
show Integer
i)
    IntConstant IntConstantKind
Hexadecimal Integer
i -> String -> Doc
text (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"0x%x" Integer
i)
    IntConstant IntConstantKind
Octal Integer
i -> String -> Doc
text (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"0%o" Integer
i)
    FloatConstant Float
f -> String -> Doc
text (Float -> String
forall a. Show a => a -> String
show Float
f)
    BoolConstant Bool
True -> String -> Doc
text String
"true"
    BoolConstant Bool
False -> String -> Doc
text String
"false"
  -- postfixExpression
    Bracket Expr
e1 Expr
e2 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
16) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
16 Expr
e1 Doc -> Doc -> Doc
<> Doc -> Doc
brackets (Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e2)
    FieldSelection Expr
e1 String
f -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
16) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
16 Expr
e1 Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> String -> Doc
text String
f
    MethodCall Expr
e1 FunctionIdentifier
i Parameters
ps -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
16) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
16 Expr
e1 Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> FunctionIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint FunctionIdentifier
i Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Parameters -> Doc
forall a. Pretty a => a -> Doc
pPrint Parameters
ps)
    FunctionCall FunctionIdentifier
i Parameters
ps -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
16) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      FunctionIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint FunctionIdentifier
i Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Parameters -> Doc
forall a. Pretty a => a -> Doc
pPrint Parameters
ps)
    PostInc Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"++"
    PostDec Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"--"
    PreInc Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"++" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
    PreDec Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"--" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
  -- unary expression
    UnaryPlus Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"+" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
    UnaryNegate Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"-" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
    UnaryNot Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"!" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
    UnaryOneComplement Expr
e1 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
15) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"~" Doc -> Doc -> Doc
<> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
15 Expr
e1
  -- binary expression
    Mul        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
14 Assoc
assocLeft String
"*" Expr
e1 Expr
e2
    Div        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
14 Assoc
assocLeft String
"/" Expr
e1 Expr
e2
    Mod        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
14 Assoc
assocLeft String
"%" Expr
e1 Expr
e2
    Add        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
13 Assoc
assocLeft String
"+" Expr
e1 Expr
e2
    Sub        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
13 Assoc
assocLeft String
"-" Expr
e1 Expr
e2
    LeftShift  Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
12 Assoc
assocLeft String
"<<" Expr
e1 Expr
e2
    RightShift Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
12 Assoc
assocLeft String
">>" Expr
e1 Expr
e2
    Lt         Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
11 Assoc
assocLeft String
"<" Expr
e1 Expr
e2
    Gt         Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
11 Assoc
assocLeft String
">" Expr
e1 Expr
e2
    Lte        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
11 Assoc
assocLeft String
"<=" Expr
e1 Expr
e2
    Gte        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
11 Assoc
assocLeft String
">=" Expr
e1 Expr
e2
    Equ        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
10 Assoc
assocLeft String
"==" Expr
e1 Expr
e2
    Neq        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
10 Assoc
assocLeft String
"!=" Expr
e1 Expr
e2
    BitAnd     Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
9 Assoc
assocLeft String
"&" Expr
e1 Expr
e2
    BitXor     Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
8 Assoc
assocLeft String
"^" Expr
e1 Expr
e2
    BitOr      Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
7 Assoc
assocLeft String
"|" Expr
e1 Expr
e2
    And        Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
6 Assoc
assocLeft String
"&&" Expr
e1 Expr
e2
-- TODO Xor 5 "^^"
    Or         Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
4 Assoc
assocLeft String
"||" Expr
e1 Expr
e2
    Selection Expr
e1 Expr
e2 Expr
e3 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
3) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
3 Expr
e1 Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
3 Expr
e2
      Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
3 Expr
e3
  -- assignment, the left Expr should be unary expression
    Equal       Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"=" Expr
e1 Expr
e2
    MulAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"*=" Expr
e1 Expr
e2
    DivAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"/=" Expr
e1 Expr
e2
    ModAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"%=" Expr
e1 Expr
e2
    AddAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"+=" Expr
e1 Expr
e2
    SubAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"-=" Expr
e1 Expr
e2
    LeftAssign  Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"<<=" Expr
e1 Expr
e2
    RightAssign Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
">>=" Expr
e1 Expr
e2
    AndAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"&=" Expr
e1 Expr
e2
    XorAssign   Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"^=" Expr
e1 Expr
e2
    OrAssign    Expr
e1 Expr
e2 -> PrettyLevel
-> Rational -> Rational -> Assoc -> String -> Expr -> Expr -> Doc
forall a.
Pretty a =>
PrettyLevel
-> Rational -> Rational -> Assoc -> String -> a -> a -> Doc
prettyBinary PrettyLevel
l Rational
p Rational
2 Assoc
assocRight String
"|=" Expr
e1 Expr
e2
  -- sequence
    Sequence Expr
e1 Expr
e2 -> Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
1 Expr
e1 Doc -> Doc -> Doc
<> Char -> Doc
char Char
',' Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> Expr -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
1 Expr
e2

instance Pretty FunctionIdentifier where
  pPrint :: FunctionIdentifier -> Doc
pPrint (FuncIdTypeSpec TypeSpecifier
t) = TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifier
t
  pPrint (FuncId String
i) = String -> Doc
text String
i

instance Pretty Parameters where
  pPrint :: Parameters -> Doc
pPrint Parameters
ParamVoid = Doc
empty
  pPrint (Params [Expr]
es) = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint [Expr]
es

instance Pretty FunctionPrototype where
  pPrint :: FunctionPrototype -> Doc
pPrint (FuncProt FullType
t String
i [ParameterDeclaration]
ps) = FullType -> Doc
forall a. Pretty a => a -> Doc
pPrint FullType
t Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'(' Doc -> Doc -> Doc
<> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ParameterDeclaration -> Doc) -> [ParameterDeclaration] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ParameterDeclaration -> Doc
forall a. Pretty a => a -> Doc
pPrint [ParameterDeclaration]
ps) Doc -> Doc -> Doc
<> String -> Doc
text String
")"

instance Pretty ParameterDeclaration where
  pPrint :: ParameterDeclaration -> Doc
pPrint (ParameterDeclaration Maybe ParameterTypeQualifier
tq Maybe ParameterQualifier
q TypeSpecifier
s Maybe (String, Maybe Expr)
i) =
    Maybe ParameterTypeQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe ParameterTypeQualifier
tq Doc -> Doc -> Doc
<+> Maybe ParameterQualifier -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe ParameterQualifier
q Doc -> Doc -> Doc
<+> TypeSpecifier -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeSpecifier
s Doc -> Doc -> Doc
<+> Maybe (String, Maybe Expr) -> Doc
forall a. Pretty a => Maybe (String, Maybe a) -> Doc
indexing' Maybe (String, Maybe Expr)
i

instance Pretty ParameterTypeQualifier  where
  pPrint :: ParameterTypeQualifier -> Doc
pPrint ParameterTypeQualifier
ConstParameter = String -> Doc
text String
"const"

instance Pretty ParameterQualifier where
  pPrint :: ParameterQualifier -> Doc
pPrint ParameterQualifier
InParameter = String -> Doc
text String
"in"
  pPrint ParameterQualifier
OutParameter = String -> Doc
text String
"out"
  pPrint ParameterQualifier
InOutParameter = String -> Doc
text String
"inout"

instance Pretty Statement where
  pPrint :: Statement -> Doc
pPrint Statement
s = case Statement
s of
  -- declaration statement
    DeclarationStatement Declaration
d -> Declaration -> Doc
forall a. Pretty a => a -> Doc
pPrint Declaration
d
  -- jump statement
    Statement
Continue -> String -> Doc
text String
"continue" Doc -> Doc -> Doc
<> Doc
semi
    Statement
Break -> String -> Doc
text String
"break" Doc -> Doc -> Doc
<> Doc
semi
    Return Maybe Expr
e -> String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Expr
e Doc -> Doc -> Doc
<> Doc
semi
    Statement
Discard -> String -> Doc
text String
"discard" Doc -> Doc -> Doc
<> Doc
semi
  -- compound statement
    CompoundStatement Compound
c -> Compound -> Doc
forall a. Pretty a => a -> Doc
pPrint Compound
c
  -- expression statement
    ExpressionStatement Maybe Expr
e -> Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Expr
e Doc -> Doc -> Doc
<> Doc
semi
  -- selection statement
    SelectionStatement Expr
e Statement
s1 Maybe Statement
s2 -> [Doc] -> Doc
vcat [String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e), Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint Statement
s1, Maybe Statement -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Statement
s2]
  -- switch statement
    SwitchStatement Expr
e [Statement]
s1 -> [Doc] -> Doc
vcat [String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e), Doc
lbrace, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Statement -> Doc) -> [Statement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint [Statement]
s1, Doc
rbrace]
    CaseLabel CaseLabel
l -> CaseLabel -> Doc
forall a. Pretty a => a -> Doc
pPrint CaseLabel
l
  -- iteration statement
    While Condition
c Statement
s1 -> [Doc] -> Doc
vcat [String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Condition -> Doc
forall a. Pretty a => a -> Doc
pPrint Condition
c), Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint Statement
s1]
    DoWhile Statement
s1 Expr
e -> [Doc] -> Doc
vcat [String -> Doc
text String
"do", Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint Statement
s1, String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e)]
    For (Left Maybe Expr
e1) Maybe Condition
c Maybe Expr
e2 Statement
s1 -> [Doc] -> Doc
vcat [String -> Doc
text String
"for", Doc -> Doc
parens (Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Expr
e1 Doc -> Doc -> Doc
<+> Doc
semi Doc -> Doc -> Doc
<+> Maybe Condition -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Condition
c Doc -> Doc -> Doc
<+> Doc
semi Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Expr
e2), Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint Statement
s1]
    For (Right Declaration
d) Maybe Condition
c Maybe Expr
e2 Statement
s1 -> [Doc] -> Doc
vcat [String -> Doc
text String
"for", Doc -> Doc
parens (Declaration -> Doc
forall a. Pretty a => a -> Doc
pPrint Declaration
d Doc -> Doc -> Doc
<+> Doc
semi Doc -> Doc -> Doc
<+> Maybe Condition -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Condition
c Doc -> Doc -> Doc
<+> Doc
semi Doc -> Doc -> Doc
<+> Maybe Expr -> Doc
forall a. Pretty a => Maybe a -> Doc
option Maybe Expr
e2), Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint Statement
s1]

instance Pretty Compound where
  pPrint :: Compound -> Doc
pPrint (Compound [Statement]
s) = [Doc] -> Doc
vcat [Doc
lbrace, Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Statement -> Doc) -> [Statement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Doc
forall a. Pretty a => a -> Doc
pPrint [Statement]
s, Doc
rbrace]

instance Pretty Condition where
  pPrint :: Condition -> Doc
pPrint (Condition Expr
e) = Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e
  pPrint (InitializedCondition FullType
t String
i Expr
e) = FullType -> Doc
forall a. Pretty a => a -> Doc
pPrint FullType
t Doc -> Doc -> Doc
<+> String -> Doc
forall a. Pretty a => a -> Doc
pPrint String
i Doc -> Doc -> Doc
<+> Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e

instance Pretty CaseLabel where
  pPrint :: CaseLabel -> Doc
pPrint  (Case Expr
e) = String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Expr -> Doc
forall a. Pretty a => a -> Doc
pPrint Expr
e Doc -> Doc -> Doc
<> Doc
colon
  pPrint CaseLabel
Default = String -> Doc
text String
"default:"