{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict     #-}
module Apigen.Language.Apidsl where

import           Apigen.Parser.SymbolTable (Name, display, displayWithin)
import           Apigen.Types              (BitSize (..), BuiltinType (..),
                                            Constness (..), Decl (..),
                                            Generated (..), Model (..),
                                            Module (..))
import           Data.Maybe                (maybeToList)
import           Data.Text                 (Text)
import qualified Data.Text                 as Text
import qualified Data.Text.Lazy            as TL
import           Language.Cimple           (Lexeme (..), lexemeText)
import           Prettyprinter
import           Prettyprinter.Render.Text as Term

type Context = [Text]

alwaysNamespace :: Bool
alwaysNamespace :: Bool
alwaysNamespace = Bool
True

commaSpace :: Doc ()
commaSpace :: Doc ()
commaSpace = Doc ()
forall ann. Doc ann
comma Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
softline

ppModel :: Model (Lexeme Name) -> Doc ()
ppModel :: Model (Lexeme Name) -> Doc ()
ppModel (Model [Module (Lexeme Name)]
mods) = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Module (Lexeme Name) -> Doc ())
-> [Module (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map Module (Lexeme Name) -> Doc ()
ppModule [Module (Lexeme Name)]
mods) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
line

ppModule :: Module (Lexeme Name) -> Doc ()
ppModule :: Module (Lexeme Name) -> Doc ()
ppModule (Module FilePath
file [Decl (Lexeme Name)]
decls) =
    FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"from \"" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\"") Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$> Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl []) [Decl (Lexeme Name)]
decls)

ppFunction :: Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction :: Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params =
    Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lparen Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
align ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hcat (Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
commaSpace ([Doc ()] -> [Doc ()]) -> [Doc ()] -> [Doc ()]
forall a b. (a -> b) -> a -> b
$ (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx) [Decl (Lexeme Name)]
params)) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rparen

ppDecl :: Context -> Decl (Lexeme Name) -> Doc ()
ppDecl :: Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx = \case
    Namespace Context
name [Decl (Lexeme Name)]
mems ->
        Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (
            FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"namespace" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> FilePath
Text.unpack (Text -> Context -> Text
Text.intercalate (FilePath -> Text
Text.pack FilePath
" ") Context
name)) Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbrace Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$>
            [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl (Context
ctx Context -> Context -> Context
forall a. [a] -> [a] -> [a]
++ Context
name)) [Decl (Lexeme Name)]
mems)
        ) Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$> Doc ()
forall ann. Doc ann
rbrace

    ClassDecl Lexeme Name
name [Decl (Lexeme Name)]
mems ->
        Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (
            FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"class" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbrace Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$>
            [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx) [Decl (Lexeme Name)]
mems)
        ) Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$> Doc ()
forall ann. Doc ann
rbrace Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi

    Enumeration [Generated]
funs Lexeme Name
name [Decl (Lexeme Name)]
mems ->
        Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (
            FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"enum" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbracket Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<>
            [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hcat (Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
commaSpace ((Generated -> Doc ()) -> [Generated] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map Generated -> Doc ()
ppGenerated [Generated]
funs))
            Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rbracket Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbrace Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$>
            [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx) [Decl (Lexeme Name)]
mems)
        ) Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$> Doc ()
forall ann. Doc ann
rbrace Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi

    Property Lexeme Name
name Decl (Lexeme Name)
prop ->
        Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (
            FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"property" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
colon Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
prop
        ) Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$> Doc ()
forall ann. Doc ann
rbrace Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    ValueProp Decl (Lexeme Name)
valType Maybe (Decl (Lexeme Name))
valGet Maybe (Decl (Lexeme Name))
valSet ->
        Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
valType Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbrace Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$>
        [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx) (Maybe (Decl (Lexeme Name)) -> [Decl (Lexeme Name)]
forall a. Maybe a -> [a]
maybeToList Maybe (Decl (Lexeme Name))
valGet [Decl (Lexeme Name)]
-> [Decl (Lexeme Name)] -> [Decl (Lexeme Name)]
forall a. [a] -> [a] -> [a]
++ Maybe (Decl (Lexeme Name)) -> [Decl (Lexeme Name)]
forall a. Maybe a -> [a]
maybeToList Maybe (Decl (Lexeme Name))
valSet))
    ArrayProp Decl (Lexeme Name)
arrType Maybe (Decl (Lexeme Name))
arrGet Maybe (Decl (Lexeme Name))
arrSet Maybe (Decl (Lexeme Name))
arrSize ->
        Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
arrType Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Doc ()
forall ann. Doc ann
lbrace Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<$$>
        [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ((Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx) (Maybe (Decl (Lexeme Name)) -> [Decl (Lexeme Name)]
forall a. Maybe a -> [a]
maybeToList Maybe (Decl (Lexeme Name))
arrGet [Decl (Lexeme Name)]
-> [Decl (Lexeme Name)] -> [Decl (Lexeme Name)]
forall a. [a] -> [a] -> [a]
++ Maybe (Decl (Lexeme Name)) -> [Decl (Lexeme Name)]
forall a. Maybe a -> [a]
maybeToList Maybe (Decl (Lexeme Name))
arrSet [Decl (Lexeme Name)]
-> [Decl (Lexeme Name)] -> [Decl (Lexeme Name)]
forall a. [a] -> [a] -> [a]
++ Maybe (Decl (Lexeme Name)) -> [Decl (Lexeme Name)]
forall a. Maybe a -> [a]
maybeToList Maybe (Decl (Lexeme Name))
arrSize))

    Method Constness
constness Decl (Lexeme Name)
ret Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"method" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
ret Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Constness -> Doc ()
ppConstness Constness
constness Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    Function Decl (Lexeme Name)
ret Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"function" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
ret Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    Constructor Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"constructor" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    Destructor Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"destructor" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    CallbackTypeDecl Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"callback" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc ()
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi
    IdTypeDecl Lexeme Name
name -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"typedef uint32_t" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name
    TypeDecl Lexeme Name
name -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"typedef struct" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi

    Var Decl (Lexeme Name)
ty Lexeme Name
name ->
        Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
ty Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name
    Define Lexeme Name
name ->
        FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"const" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
semi

    Typename Lexeme Name
name -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name
    EnumMember Lexeme Name
name -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
comma
    BuiltinType BuiltinType
ty -> BuiltinType -> Doc ()
ppBuiltinType BuiltinType
ty
    CallbackType Lexeme Name
ty -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
ty
    PointerType Lexeme Name
ty -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'
    ConstPointerType Lexeme Name
ty -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"const" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'
    SizedArrayType Decl (Lexeme Name)
ty Decl (Lexeme Name)
name -> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lbracket Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
name Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rbracket
    ArrayType BuiltinType
ty -> BuiltinType -> Doc ()
ppBuiltinType BuiltinType
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lbracket Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'?' Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rbracket
    UserArrayType Lexeme Name
ty -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lbracket Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'?' Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rbracket
    ConstArrayType BuiltinType
ty -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"const" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> BuiltinType -> Doc ()
ppBuiltinType BuiltinType
ty Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lbracket Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'?' Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rbracket
    ConstType Decl (Lexeme Name)
ty -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"const" Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
ty

    Paren Decl (Lexeme Name)
expr -> Doc ()
forall ann. Doc ann
lparen Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
expr Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rparen
    Ref Lexeme Name
name -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
name
    IntVal Lexeme Name
val -> Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx Lexeme Name
val
    Abs Decl (Lexeme Name)
e -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"abs" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lparen Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
e Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rparen
    Max Decl (Lexeme Name)
a Decl (Lexeme Name)
b -> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"max" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
lparen Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
a Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
comma Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
b Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
rparen
    Add Decl (Lexeme Name)
l Decl (Lexeme Name)
r -> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
l Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'+' Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
r
    Sub Decl (Lexeme Name)
l Decl (Lexeme Name)
r -> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
l Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-' Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
r
    Mul Decl (Lexeme Name)
l Decl (Lexeme Name)
r -> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
l Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*' Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
r
    Div Decl (Lexeme Name)
l Decl (Lexeme Name)
r -> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
l Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
'/' Doc () -> Doc () -> Doc ()
forall a. Doc a -> Doc a -> Doc a
<+> Context -> Decl (Lexeme Name) -> Doc ()
ppDecl Context
ctx Decl (Lexeme Name)
r

ppGenerated :: Generated -> Doc ()
ppGenerated :: Generated -> Doc ()
ppGenerated Generated
GeneratedToString = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"to_string"
ppGenerated Generated
GeneratedFromInt  = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"from_int"

ppConstness :: Constness -> Doc ()
ppConstness :: Constness -> Doc ()
ppConstness Constness
ConstThis   = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"const"
ppConstness Constness
MutableThis = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"mutable"

ppBuiltinType :: BuiltinType -> Doc ()
ppBuiltinType :: BuiltinType -> Doc ()
ppBuiltinType BuiltinType
Void      = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"void"
ppBuiltinType BuiltinType
VoidPtr   = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"void*"
ppBuiltinType BuiltinType
Bool      = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"bool"
ppBuiltinType BuiltinType
Char      = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"pretty"
ppBuiltinType (SInt BitSize
bs) = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"int" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> BitSize -> Doc ()
ppBitSize BitSize
bs Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"_t"
ppBuiltinType (UInt BitSize
bs) = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"uint" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> BitSize -> Doc ()
ppBitSize BitSize
bs Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"_t"
ppBuiltinType BuiltinType
SizeT     = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"size_t"
ppBuiltinType BuiltinType
String    = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"string"

ppBitSize :: BitSize -> Doc ()
ppBitSize :: BitSize -> Doc ()
ppBitSize BitSize
B8  = Int -> Doc ()
int Int
8
ppBitSize BitSize
B16 = Int -> Doc ()
int Int
16
ppBitSize BitSize
B32 = Int -> Doc ()
int Int
32
ppBitSize BitSize
B64 = Int -> Doc ()
int Int
64

ppMaybe :: (a -> Doc ()) -> Maybe a -> Doc ()
ppMaybe :: (a -> Doc ()) -> Maybe a -> Doc ()
ppMaybe a -> Doc ()
_ Maybe a
Nothing  = Doc ()
forall a. Monoid a => a
mempty
ppMaybe a -> Doc ()
f (Just a
x) = a -> Doc ()
f a
x

ppLexeme :: Context -> Lexeme Name -> Doc ()
ppLexeme :: Context -> Lexeme Name -> Doc ()
ppLexeme Context
ctx = FilePath -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty (FilePath -> Doc ())
-> (Lexeme Name -> FilePath) -> Lexeme Name -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
nonEmpty (FilePath -> FilePath)
-> (Lexeme Name -> FilePath) -> Lexeme Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
alwaysNamespace then Name -> FilePath
display else Context -> Name -> FilePath
displayWithin Context
ctx) (Name -> FilePath)
-> (Lexeme Name -> Name) -> Lexeme Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme Name -> Name
forall text. Lexeme text -> text
lexemeText
  where
    nonEmpty :: FilePath -> FilePath
nonEmpty FilePath
"" = FilePath
"this"
    nonEmpty FilePath
t  = FilePath
t

renderSmart :: Float -> Int -> Doc () -> SimpleDocStream ()
renderSmart :: Float -> Int -> Doc () -> SimpleDocStream ()
renderSmart Float
ribbonFraction Int
widthPerLine
    = LayoutOptions -> Doc () -> SimpleDocStream ()
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 () -> String
renderS :: Doc () -> FilePath
renderS = Text -> FilePath
Text.unpack (Text -> FilePath) -> (Doc () -> Text) -> Doc () -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> Text
render

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

generate :: Model (Lexeme Name) -> Text
generate :: Model (Lexeme Name) -> Text
generate = Doc () -> Text
render (Doc () -> Text)
-> (Model (Lexeme Name) -> Doc ()) -> Model (Lexeme Name) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model (Lexeme Name) -> Doc ()
ppModel

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

int :: Int -> Doc ()
int :: Int -> Doc ()
int = Int -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty