{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{- HLINT ignore "Functor law" -}
{- HLINT ignore "Use <$" -}
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           Language.Cimple              (Lexeme (..), lexemeText)
import           Prelude                      hiding ((<$>))
import           Text.PrettyPrint.ANSI.Leijen

type Context = [Text]

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

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

ppModel :: Model (Lexeme Name) -> Doc
ppModel :: Model (Lexeme Name) -> Doc
ppModel (Model [Module (Lexeme Name)]
mods) = [Doc] -> Doc
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
line

ppModule :: Module (Lexeme Name) -> Doc
ppModule :: Module (Lexeme Name) -> Doc
ppModule (Module FilePath
file [Decl (Lexeme Name)]
decls) =
    FilePath -> Doc
text FilePath
"from \"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
file Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\"" Doc -> Doc -> Doc
<$> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
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
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
align ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
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
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
nest Int
2 (
            FilePath -> Doc
text FilePath
"namespace" Doc -> Doc -> Doc
<+> FilePath -> Doc
text (Text -> FilePath
Text.unpack (Text -> Context -> Text
Text.intercalate Text
"_" Context
name)) Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
            [Doc] -> Doc
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
<$> Doc
rbrace

    ClassDecl Lexeme Name
name [Decl (Lexeme Name)]
mems ->
        Int -> Doc -> Doc
nest Int
2 (
            FilePath -> Doc
text FilePath
"class" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
            [Doc] -> Doc
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
<$> Doc
rbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

    Enumeration [Generated]
funs Lexeme Name
name [Decl (Lexeme Name)]
mems ->
        Int -> Doc -> Doc
nest Int
2 (
            FilePath -> Doc
text FilePath
"enum" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
<+> Doc
lbracket Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
            [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
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
rbracket Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
            [Doc] -> Doc
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
<$> Doc
rbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

    Property Lexeme Name
name Decl (Lexeme Name)
prop ->
        Int -> Doc -> Doc
nest Int
2 (
            FilePath -> Doc
text FilePath
"property" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
prop
        ) Doc -> Doc -> Doc
<$> Doc
rbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
        [Doc] -> Doc
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
<+> Doc
lbrace Doc -> Doc -> Doc
<$>
        [Doc] -> Doc
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
text FilePath
"method" Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
ret Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> [Decl (Lexeme Name)] -> Doc
ppFunction Context
ctx Lexeme Name
name [Decl (Lexeme Name)]
params Doc -> Doc -> Doc
<+> Constness -> Doc
ppConstness Constness
constness Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
    Function Decl (Lexeme Name)
ret Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc
text FilePath
"function" Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
ret Doc -> Doc -> Doc
<+> 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
semi
    Constructor Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc
text FilePath
"constructor" Doc -> Doc -> Doc
<+> 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
semi
    Destructor Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc
text FilePath
"destructor" Doc -> Doc -> Doc
<+> 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
semi
    CallbackTypeDecl Lexeme Name
name [Decl (Lexeme Name)]
params ->
        FilePath -> Doc
text FilePath
"callback" Doc -> Doc -> Doc
<+> 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
semi
    IdTypeDecl Lexeme Name
name -> FilePath -> Doc
text FilePath
"typedef uint32_t" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name
    TypeDecl Lexeme Name
name -> Doc
"typedef struct" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi

    Var Decl (Lexeme Name)
ty Lexeme Name
name ->
        Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
ty Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name
    Define Lexeme Name
name ->
        FilePath -> Doc
text FilePath
"const" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
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
char Char
'*'
    ConstPointerType Lexeme Name
ty -> FilePath -> Doc
text FilePath
"const" Doc -> Doc -> Doc
<+> Context -> Lexeme Name -> Doc
ppLexeme Context
ctx Lexeme Name
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char 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
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
rbracket
    ArrayType BuiltinType
ty -> BuiltinType -> Doc
ppBuiltinType BuiltinType
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lbracket Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
lbracket Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
    ConstArrayType BuiltinType
ty -> Doc
"const" Doc -> Doc -> Doc
<+> BuiltinType -> Doc
ppBuiltinType BuiltinType
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lbracket Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket
    ConstType Decl (Lexeme Name)
ty -> FilePath -> Doc
text FilePath
"const" Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
ty

    Paren Decl (Lexeme Name)
expr -> Doc
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
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
text FilePath
"abs" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
rparen
    Max Decl (Lexeme Name)
a Decl (Lexeme Name)
b -> FilePath -> Doc
text FilePath
"max" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
comma Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
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
<+> Char -> Doc
char Char
'+' Doc -> Doc -> Doc
<+> 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
<+> Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<+> 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
<+> Char -> Doc
char Char
'*' Doc -> Doc -> Doc
<+> 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
<+> Char -> Doc
char Char
'/' Doc -> Doc -> Doc
<+> Context -> Decl (Lexeme Name) -> Doc
ppDecl Context
ctx Decl (Lexeme Name)
r

ppGenerated :: Generated -> Doc
ppGenerated :: Generated -> Doc
ppGenerated Generated
GeneratedToString = FilePath -> Doc
text FilePath
"to_string"
ppGenerated Generated
GeneratedFromInt  = FilePath -> Doc
text FilePath
"from_int"

ppConstness :: Constness -> Doc
ppConstness :: Constness -> Doc
ppConstness Constness
ConstThis   = FilePath -> Doc
text FilePath
"const"
ppConstness Constness
MutableThis = FilePath -> Doc
text FilePath
"mutable"

ppBuiltinType :: BuiltinType -> Doc
ppBuiltinType :: BuiltinType -> Doc
ppBuiltinType BuiltinType
Void      = FilePath -> Doc
text FilePath
"void"
ppBuiltinType BuiltinType
VoidPtr   = FilePath -> Doc
text FilePath
"void*"
ppBuiltinType BuiltinType
Bool      = FilePath -> Doc
text FilePath
"bool"
ppBuiltinType BuiltinType
Char      = FilePath -> Doc
text FilePath
"char"
ppBuiltinType (SInt BitSize
bs) = FilePath -> Doc
text 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
text FilePath
"_t"
ppBuiltinType (UInt BitSize
bs) = FilePath -> Doc
text 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
text FilePath
"_t"
ppBuiltinType BuiltinType
SizeT     = FilePath -> Doc
text FilePath
"size_t"
ppBuiltinType BuiltinType
String    = FilePath -> Doc
text 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
empty
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
text (FilePath -> Doc)
-> (Lexeme Name -> FilePath) -> Lexeme Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall p. (Eq p, IsString p) => p -> p
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 :: p -> p
nonEmpty p
"" = p
"this"
    nonEmpty p
t  = p
t

renderS :: Doc -> String
renderS :: Doc -> FilePath
renderS = (SimpleDoc -> FilePath -> FilePath)
-> FilePath -> SimpleDoc -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleDoc -> FilePath -> FilePath
displayS FilePath
"" (SimpleDoc -> FilePath) -> (Doc -> SimpleDoc) -> Doc -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
renderSmart Float
1 Int
120

render :: Doc -> Text
render :: Doc -> Text
render = FilePath -> Text
Text.pack (FilePath -> Text) -> (Doc -> FilePath) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
renderS

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