{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Language.GLSL.PrettyPrint where

import           Data.List                        (intersperse)
import qualified Data.Text.Lazy                   as LT
import qualified Data.Text.Lazy.Builder           as LTB
import qualified Data.Text.Lazy.Builder.Int       as LTB
import qualified Data.Text.Lazy.Builder.RealFloat as LTB
import           Language.GLSL.AST


printShader :: Annot a => GLSL a -> LT.Text
printShader :: GLSL a -> Text
printShader = Builder -> Text
LTB.toLazyText (Builder -> Text) -> (GLSL a -> Builder) -> GLSL a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLSL a -> Builder
forall a. Annot a => GLSL a -> Builder
ppGLSL

-- | Pretty-print GLSL

ppGLSL :: Annot a => GLSL a -> LTB.Builder
ppGLSL :: GLSL a -> Builder
ppGLSL (GLSL Version
v [TopDecl a]
decls) =
  Version -> Builder
ppVersion Version
v
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TopDecl a -> Builder) -> [TopDecl a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL TopDecl a -> Builder
forall a. Annot a => TopDecl a -> Builder
ppTopDecl [TopDecl a]
decls

-- | Pretty-print Version

ppVersion :: Version -> LTB.Builder
ppVersion :: Version -> Builder
ppVersion (Version Int
v) = Builder
"#version " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
v

-- | Pretty-print TopDecl

ppTopDecl :: Annot a => TopDecl a -> LTB.Builder
ppTopDecl :: TopDecl a -> Builder
ppTopDecl (LayoutDecl LayoutSpec
e GlobalDecl
d) = Builder
"layout(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LayoutSpec -> Builder
ppLayoutSpec LayoutSpec
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> GlobalDecl -> Builder
ppGlobalDecl GlobalDecl
d
ppTopDecl (GlobalDecl GlobalDecl
d) = GlobalDecl -> Builder
ppGlobalDecl GlobalDecl
d
ppTopDecl (ProcDecl ProcName
n [ParamDecl]
a [StmtAnnot a]
b) =
  Builder
"void " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProcName -> Builder
ppProcName ProcName
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (ParamDecl -> Builder) -> [ParamDecl] -> Builder
forall a. Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
"," ParamDecl -> Builder
ppParamDecl [ParamDecl]
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") {\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
b
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"

-- | Pretty-print ProcName

ppProcName :: ProcName -> LTB.Builder
ppProcName :: ProcName -> Builder
ppProcName ProcName
ProcMain     = Builder
"main"
ppProcName (ProcName NameId
n) = Builder
"p" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n

-- | Pretty-print LayoutSpec

ppLayoutSpec :: LayoutSpec -> LTB.Builder
ppLayoutSpec :: LayoutSpec -> Builder
ppLayoutSpec LayoutSpec
LayoutStd140       = Builder
"std140"
ppLayoutSpec (LayoutLocation Int
l) = Builder
"location = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
l

-- | Pretty-print ParamDecl

ppParamDecl :: ParamDecl -> LTB.Builder
ppParamDecl :: ParamDecl -> Builder
ppParamDecl (Param ParamKind
k LocalDecl
d) =
  ParamKind -> Builder
ppParamKind ParamKind
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LocalDecl -> Builder
ppLocalDecl LocalDecl
d

-- | Pretty-print ParamKind

ppParamKind :: ParamKind -> LTB.Builder
ppParamKind :: ParamKind -> Builder
ppParamKind ParamKind
PkIn    = Builder
"in"
ppParamKind ParamKind
PkOut   = Builder
"out"
ppParamKind ParamKind
PkInout = Builder
"inout"

-- | Pretty-print LocalDecl

ppLocalDecl :: LocalDecl -> LTB.Builder
ppLocalDecl :: LocalDecl -> Builder
ppLocalDecl (LDecl Type
t NameId
n Maybe Expr
Nothing) =
  Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppLocalDecl (LDecl Type
t NameId
n (Just Expr
e)) =
  Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

-- | Pretty-print GlobalDecl

ppGlobalDecl :: GlobalDecl -> LTB.Builder
ppGlobalDecl :: GlobalDecl -> Builder
ppGlobalDecl (GDecl GDeclKind
k Type
t Name
n) =
  GDeclKind -> Builder
ppGDeclKind GDeclKind
k
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Type -> Builder
ppType Type
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Name -> Builder
ppName Name
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

-- | Pretty-print GDeclKind

ppGDeclKind :: GDeclKind -> LTB.Builder
ppGDeclKind :: GDeclKind -> Builder
ppGDeclKind GDeclKind
GkIn      = Builder
"in"
ppGDeclKind GDeclKind
GkOut     = Builder
"out"
ppGDeclKind GDeclKind
GkUniform = Builder
"uniform"

-- | Pretty-print Type

ppType :: Type -> LTB.Builder
ppType :: Type -> Builder
ppType Type
TyBool = Builder
"bool"
ppType Type
TyFloat = Builder
"float"
ppType Type
TySampler2D = Builder
"sampler2D"
ppType (TyVec Int
n) = Builder
"vec" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
n
ppType (TyMat Int
n Int
m) = Builder
"mat" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
m
ppType (TyStruct NameId
n [(Type, NameId)]
ms) =
  Builder
"uBlock" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" {\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Type, NameId) -> Builder) -> [(Type, NameId)] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL (Type, NameId) -> Builder
ppStructMember [(Type, NameId)]
ms Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
  where ppStructMember :: (Type, NameId) -> Builder
ppStructMember (Type
t, NameId
m) = Type -> Builder
ppType Type
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"

-- | Pretty-print NameId

ppNameId :: NameId -> LTB.Builder
ppNameId :: NameId -> Builder
ppNameId (NameId Int
n) = Int -> Builder
ppInt Int
n

-- | Pretty-print Name

ppName :: Name -> LTB.Builder
ppName :: Name -> Builder
ppName (Name Namespace
ns NameId
n) = Namespace -> Builder
ppNamespace Namespace
ns Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n

-- | Pretty-print Namespace

ppNamespace :: Namespace -> LTB.Builder
ppNamespace :: Namespace -> Builder
ppNamespace Namespace
NsT   = Builder
"t"
ppNamespace Namespace
NsS   = Builder
"s"
ppNamespace Namespace
NsU   = Builder
"u"
ppNamespace Namespace
NsVF  = Builder
"vf"
ppNamespace Namespace
NsIn  = Builder
"in"
ppNamespace Namespace
NsOut = Builder
"out"

-- | Pretty-print FunName

ppFunName :: FunName -> LTB.Builder
ppFunName :: FunName -> Builder
ppFunName FunName
PrimAbs        = Builder
"abs"
ppFunName FunName
PrimAsin       = Builder
"asin"
ppFunName FunName
PrimAtan       = Builder
"atan"
ppFunName FunName
PrimCos        = Builder
"cos"
ppFunName FunName
PrimCross      = Builder
"cross"
ppFunName FunName
PrimDot        = Builder
"dot"
ppFunName FunName
PrimFloor      = Builder
"floor"
ppFunName FunName
PrimFract      = Builder
"fract"
ppFunName FunName
PrimLength     = Builder
"length"
ppFunName FunName
PrimMat3x3     = Builder
"mat3x3"
ppFunName FunName
PrimMat4x4     = Builder
"mat4x4"
ppFunName FunName
PrimMod        = Builder
"mod"
ppFunName FunName
PrimNormalize  = Builder
"normalize"
ppFunName FunName
PrimPow        = Builder
"pow"
ppFunName FunName
PrimSin        = Builder
"sin"
ppFunName FunName
PrimSmoothstep = Builder
"smoothstep"
ppFunName FunName
PrimSqrt       = Builder
"sqrt"
ppFunName FunName
PrimStep       = Builder
"step"
ppFunName FunName
PrimTan        = Builder
"tan"
ppFunName FunName
PrimVec2       = Builder
"vec2"
ppFunName FunName
PrimVec3       = Builder
"vec3"
ppFunName FunName
PrimVec4       = Builder
"vec4"

-- | Pretty-print Swizzle

ppSwizzle :: Swizzle -> LTB.Builder
ppSwizzle :: Swizzle -> Builder
ppSwizzle Swizzle
X = Builder
"x"
ppSwizzle Swizzle
Y = Builder
"y"
ppSwizzle Swizzle
Z = Builder
"z"
ppSwizzle Swizzle
W = Builder
"w"

-- | Pretty-print VecIndex (Swizzle)

ppVecIndex :: Swizzle -> LTB.Builder
ppVecIndex :: Swizzle -> Builder
ppVecIndex Swizzle
X = Builder
"0"
ppVecIndex Swizzle
Y = Builder
"1"
ppVecIndex Swizzle
Z = Builder
"2"
ppVecIndex Swizzle
W = Builder
"3"

-- | Pretty-print NameExpr

ppNameExpr :: NameExpr -> LTB.Builder
ppNameExpr :: NameExpr -> Builder
ppNameExpr (NameExpr Name
n)      = Name -> Builder
ppName Name
n
ppNameExpr (UniformExpr NameId
n NameId
m) = Builder
"u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
".u" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
m

-- | Pretty-print ExprAtom

ppExprAtom :: ExprAtom -> LTB.Builder
ppExprAtom :: ExprAtom -> Builder
ppExprAtom (LitIntExpr Cast
Cast Int
i)     = Builder
"int(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
ppInt Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExprAtom (LitIntExpr Cast
NoCast Int
i)   = Int -> Builder
ppInt Int
i
ppExprAtom (LitFloatExpr Cast
Cast Float
n)   = Builder
"float(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
ppFloat Float
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExprAtom (LitFloatExpr Cast
NoCast Float
r) = Float -> Builder
ppFloat Float
r
ppExprAtom (IdentifierExpr NameExpr
n)      = NameExpr -> Builder
ppNameExpr NameExpr
n
ppExprAtom (SwizzleExpr NameId
n Swizzle
m)       = Builder
"t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppSwizzle Swizzle
m
ppExprAtom (VecIndexExpr NameExpr
n Swizzle
i)      = NameExpr -> Builder
ppNameExpr NameExpr
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
ppExprAtom (MatIndexExpr NameExpr
n Swizzle
i Swizzle
j)    = NameExpr -> Builder
ppNameExpr NameExpr
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Swizzle -> Builder
ppVecIndex Swizzle
j Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"

-- | Pretty-print Expr

ppExpr :: Expr -> LTB.Builder
ppExpr :: Expr -> Builder
ppExpr (AtomExpr ExprAtom
e) = ExprAtom -> Builder
ppExprAtom ExprAtom
e
ppExpr (UnaryExpr UnaryOp
o ExprAtom
e) = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> UnaryOp -> Builder
ppUnaryOp UnaryOp
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (BinaryExpr ExprAtom
l BinaryOp
o ExprAtom
r) = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> BinaryOp -> Builder
ppBinaryOp BinaryOp
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (FunCallExpr FunName
n [ExprAtom]
args) = FunName -> Builder
ppFunName FunName
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (ExprAtom -> Builder) -> [ExprAtom] -> Builder
forall a. Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
"," ExprAtom -> Builder
ppExprAtom [ExprAtom]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
ppExpr (TextureExpr ExprAtom
t ExprAtom
x ExprAtom
y) = Builder
"texture(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
",vec2(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ExprAtom -> Builder
ppExprAtom ExprAtom
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"))"

-- | Pretty-print BinaryOp

ppBinaryOp :: BinaryOp -> LTB.Builder
ppBinaryOp :: BinaryOp -> Builder
ppBinaryOp BinaryOp
BOpPlus  = Builder
"+"
ppBinaryOp BinaryOp
BOpMinus = Builder
"-"
ppBinaryOp BinaryOp
BOpMul   = Builder
"*"
ppBinaryOp BinaryOp
BOpDiv   = Builder
"/"
ppBinaryOp BinaryOp
BOpGE    = Builder
">="
ppBinaryOp BinaryOp
BOpGT    = Builder
">"
ppBinaryOp BinaryOp
BOpLE    = Builder
"<="
ppBinaryOp BinaryOp
BOpLT    = Builder
"<"
ppBinaryOp BinaryOp
BOpAnd   = Builder
"&&"
ppBinaryOp BinaryOp
BOpOr    = Builder
"||"

-- | Pretty-print UnaryOp

ppUnaryOp :: UnaryOp -> LTB.Builder
ppUnaryOp :: UnaryOp -> Builder
ppUnaryOp UnaryOp
UOpMinus = Builder
"-"
ppUnaryOp UnaryOp
UOpNot   = Builder
"!"

-- | Pretty-print StmtAnnot

ppStmtAnnot :: Annot a => StmtAnnot a -> LTB.Builder
ppStmtAnnot :: StmtAnnot a -> Builder
ppStmtAnnot (SA a
a Stmt a
s) =
  Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (\Builder
ltb -> Builder
"// " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ltb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (a -> Maybe Builder
forall a. Annot a => a -> Maybe Builder
ppAnnot a
a) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Stmt a -> Builder
forall a. Annot a => Stmt a -> Builder
ppStmt Stmt a
s

-- | Pretty-print Stmt

ppStmt :: Annot a => Stmt a -> LTB.Builder
ppStmt :: Stmt a -> Builder
ppStmt (AssignStmt Name
n Expr
e) = Name -> Builder
ppName Name
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppStmt (DeclStmt LocalDecl
d) = LocalDecl -> Builder
ppLocalDecl LocalDecl
d
ppStmt (EmitStmt Emit
e) = Emit -> Builder
ppEmit Emit
e
ppStmt (IfStmt NameId
c [StmtAnnot a]
t [StmtAnnot a]
e) =
  Builder
"if(t" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameId -> Builder
ppNameId NameId
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"){\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
t
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"} else {\n"
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (StmtAnnot a -> Builder) -> [StmtAnnot a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL StmtAnnot a -> Builder
forall a. Annot a => StmtAnnot a -> Builder
ppStmtAnnot [StmtAnnot a]
e
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"

-- | Pretty-print Emit

ppEmit :: Emit -> LTB.Builder
ppEmit :: Emit -> Builder
ppEmit (EmitPosition Expr
e) = Builder
"gl_Position = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr -> Builder
ppExpr Expr
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";\n"
ppEmit Emit
EmitFragDepth    = Builder
"gl_FragDepth = gl_FragCoord[2];\n"

-- | Pretty-printing utility

ppInt :: Int -> LTB.Builder
ppInt :: Int -> Builder
ppInt = Int -> Builder
forall a. Integral a => a -> Builder
LTB.decimal

ppFloat :: Float -> LTB.Builder
ppFloat :: Float -> Builder
ppFloat = Float -> Builder
forall a. RealFloat a => a -> Builder
LTB.realFloat

ppL :: (a -> LTB.Builder) -> [a] -> LTB.Builder
ppL :: (a -> Builder) -> [a] -> Builder
ppL a -> Builder
printer = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
printer

ppS :: LTB.Builder -> (a -> LTB.Builder) -> [a] -> LTB.Builder
ppS :: Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
sep a -> Builder
printer = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
sep ([Builder] -> [Builder]) -> ([a] -> [Builder]) -> [a] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
printer

----------------------------------
-- Pretty-printing to String

pp :: (a -> LTB.Builder) -> a -> String
pp :: (a -> Builder) -> a -> String
pp a -> Builder
printer = Text -> String
LT.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
printer

ppl :: (a -> LTB.Builder) -> [a] -> String
ppl :: (a -> Builder) -> [a] -> String
ppl a -> Builder
printer = Text -> String
LT.unpack (Text -> String) -> ([a] -> Text) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> ([a] -> Builder) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> Builder
forall a. (a -> Builder) -> [a] -> Builder
ppL a -> Builder
printer

pps :: LTB.Builder -> (a -> LTB.Builder) -> [a] -> String
pps :: Builder -> (a -> Builder) -> [a] -> String
pps Builder
sep a -> Builder
printer = Text -> String
LT.unpack (Text -> String) -> ([a] -> Text) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LTB.toLazyText (Builder -> Text) -> ([a] -> Builder) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> (a -> Builder) -> [a] -> Builder
forall a. Builder -> (a -> Builder) -> [a] -> Builder
ppS Builder
sep a -> Builder
printer