{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
{- HLINT ignore "Functor law" -}
{- HLINT ignore "Use <$" -}
module Apigen.Language.PyDsl (generate) where

import           Apigen.Parser.SymbolTable    (Name)
import           Apigen.Types                 (BitSize (..), BuiltinType (..),
                                               Constness (..), Decl (..),
                                               Generated (..), Model (..),
                                               Module (..))
import           Data.Text                    (Text)
import qualified Data.Text                    as Text
import           Language.Cimple              (Lexeme (..), LexemeClass)
import           Prelude                      hiding ((<$>))
import           Text.PrettyPrint.ANSI.Leijen

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

commaSep :: [Doc] -> [Doc]
commaSep :: [Doc] -> [Doc]
commaSep = Doc -> [Doc] -> [Doc]
punctuate Doc
commaSpace

go :: ([Doc] -> Doc) -> String -> [Doc] -> Doc
go :: ([Doc] -> Doc) -> String -> [Doc] -> Doc
go [Doc] -> Doc
f String
cls [Doc]
mems = String -> Doc
ppCtor String
cls Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
f ([Doc] -> [Doc]
commaSep [Doc]
mems) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen

ppCtor :: String -> Doc
ppCtor :: String -> Doc
ppCtor = String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"apigen." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)

hgo :: String -> [Doc] -> Doc
hgo :: String -> [Doc] -> Doc
hgo = ([Doc] -> Doc) -> String -> [Doc] -> Doc
go [Doc] -> Doc
hcat

vgo :: String -> [Doc] -> Doc
vgo :: String -> [Doc] -> Doc
vgo = ([Doc] -> Doc) -> String -> [Doc] -> Doc
go [Doc] -> Doc
vcat

ppList :: (a -> Doc) -> [a] -> Doc
ppList :: (a -> Doc) -> [a] -> Doc
ppList a -> Doc
pp [a]
l = Doc
lbracket Doc -> Doc -> Doc
<//> [Doc] -> Doc
hcat ([Doc] -> [Doc]
commaSep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
pp [a]
l)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbracket

ppModel :: Model (Lexeme Name) -> Doc
ppModel :: Model (Lexeme Name) -> Doc
ppModel (Model [Module (Lexeme Name)]
mods) =
    String -> [Doc] -> Doc
vgo String
"Model" [(Module (Lexeme Name) -> Doc) -> [Module (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList 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 String
file [Decl (Lexeme Name)]
decls) =
    String -> [Doc] -> Doc
vgo String
"Module" [Doc
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
file Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\"", (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
decls]

ppDecl :: Decl (Lexeme Name) -> Doc
ppDecl :: Decl (Lexeme Name) -> Doc
ppDecl = \case
    Namespace [Text]
name [Decl (Lexeme Name)]
mems                     -> String -> [Doc] -> Doc
vgo String
"Namespace" [(Text -> Doc) -> [Text] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList (String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) [Text]
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
mems]
    ClassDecl Lexeme Name
name [Decl (Lexeme Name)]
mems                     -> String -> [Doc] -> Doc
vgo String
"ClassDecl" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
mems]
    Enumeration [Generated]
funs Lexeme Name
name [Decl (Lexeme Name)]
mems              -> String -> [Doc] -> Doc
vgo String
"Enumeration" [(Generated -> Doc) -> [Generated] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Generated -> Doc
ppGenerated [Generated]
funs, Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
mems]
    Property Lexeme Name
name Decl (Lexeme Name)
prop                      -> String -> [Doc] -> Doc
hgo String
"Property" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
prop]
    ValueProp Decl (Lexeme Name)
valType Maybe (Decl (Lexeme Name))
valGet Maybe (Decl (Lexeme Name))
valSet         -> String -> [Doc] -> Doc
hgo String
"ValueProp" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
valType, (Decl (Lexeme Name) -> Doc) -> Maybe (Decl (Lexeme Name)) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
ppMaybe Decl (Lexeme Name) -> Doc
ppDecl Maybe (Decl (Lexeme Name))
valGet, (Decl (Lexeme Name) -> Doc) -> Maybe (Decl (Lexeme Name)) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
ppMaybe Decl (Lexeme Name) -> Doc
ppDecl 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 -> String -> [Doc] -> Doc
hgo String
"ArrayProp" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
arrType, (Decl (Lexeme Name) -> Doc) -> Maybe (Decl (Lexeme Name)) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
ppMaybe Decl (Lexeme Name) -> Doc
ppDecl Maybe (Decl (Lexeme Name))
arrGet, (Decl (Lexeme Name) -> Doc) -> Maybe (Decl (Lexeme Name)) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
ppMaybe Decl (Lexeme Name) -> Doc
ppDecl Maybe (Decl (Lexeme Name))
arrSet, (Decl (Lexeme Name) -> Doc) -> Maybe (Decl (Lexeme Name)) -> Doc
forall a. (a -> Doc) -> Maybe a -> Doc
ppMaybe Decl (Lexeme Name) -> Doc
ppDecl Maybe (Decl (Lexeme Name))
arrSize]
    Method Constness
constness Decl (Lexeme Name)
ret Lexeme Name
name [Decl (Lexeme Name)]
params        -> String -> [Doc] -> Doc
hgo String
"Method" [Constness -> Doc
ppConstness Constness
constness, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
ret, Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
params]
    Function Decl (Lexeme Name)
ret Lexeme Name
name [Decl (Lexeme Name)]
params                -> String -> [Doc] -> Doc
hgo String
"Function" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
ret, Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
params]
    Constructor Lexeme Name
name [Decl (Lexeme Name)]
params                 -> String -> [Doc] -> Doc
hgo String
"Constructor" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
params]
    Destructor Lexeme Name
name [Decl (Lexeme Name)]
params                  -> String -> [Doc] -> Doc
hgo String
"Destructor" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
params]
    CallbackTypeDecl Lexeme Name
name [Decl (Lexeme Name)]
params            -> String -> [Doc] -> Doc
hgo String
"CallbackTypeDecl" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name, (Decl (Lexeme Name) -> Doc) -> [Decl (Lexeme Name)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList Decl (Lexeme Name) -> Doc
ppDecl [Decl (Lexeme Name)]
params]
    IdTypeDecl Lexeme Name
name                         -> String -> [Doc] -> Doc
hgo String
"IdTypeDecl" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    TypeDecl Lexeme Name
name                           -> String -> [Doc] -> Doc
hgo String
"TypeDecl" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    Var Decl (Lexeme Name)
ty Lexeme Name
name                             -> String -> [Doc] -> Doc
hgo String
"Var" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
ty, Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    Define Lexeme Name
name                             -> String -> [Doc] -> Doc
hgo String
"Define" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    Typename Lexeme Name
name                           -> String -> [Doc] -> Doc
hgo String
"Typename" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    EnumMember Lexeme Name
name                         -> String -> [Doc] -> Doc
hgo String
"EnumMember" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    BuiltinType BuiltinType
ty                          -> String -> [Doc] -> Doc
hgo String
"BuiltinType" [BuiltinType -> Doc
ppBuiltinType BuiltinType
ty]
    CallbackType Lexeme Name
ty                         -> String -> [Doc] -> Doc
hgo String
"CallbackType" [Lexeme Name -> Doc
ppLexeme Lexeme Name
ty]
    PointerType Lexeme Name
ty                          -> String -> [Doc] -> Doc
hgo String
"PointerType" [Lexeme Name -> Doc
ppLexeme Lexeme Name
ty]
    ConstPointerType Lexeme Name
ty                     -> String -> [Doc] -> Doc
hgo String
"ConstPointerType" [Lexeme Name -> Doc
ppLexeme Lexeme Name
ty]
    SizedArrayType Decl (Lexeme Name)
ty Decl (Lexeme Name)
name                  -> String -> [Doc] -> Doc
hgo String
"SizedArrayType" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
ty, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
name]
    ArrayType BuiltinType
ty                            -> String -> [Doc] -> Doc
hgo String
"ArrayType" [BuiltinType -> Doc
ppBuiltinType BuiltinType
ty]
    UserArrayType Lexeme Name
ty                        -> String -> [Doc] -> Doc
hgo String
"UserArrayType" [Lexeme Name -> Doc
ppLexeme Lexeme Name
ty]
    ConstArrayType BuiltinType
ty                       -> String -> [Doc] -> Doc
hgo String
"ConstArrayType" [BuiltinType -> Doc
ppBuiltinType BuiltinType
ty]
    ConstType Decl (Lexeme Name)
ty                            -> String -> [Doc] -> Doc
hgo String
"ConstType" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
ty]
    Paren Decl (Lexeme Name)
expr                              -> String -> [Doc] -> Doc
hgo String
"Paren" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
expr]
    Ref Lexeme Name
name                                -> String -> [Doc] -> Doc
hgo String
"Ref" [Lexeme Name -> Doc
ppLexeme Lexeme Name
name]
    IntVal Lexeme Name
val                              -> String -> [Doc] -> Doc
hgo String
"IntVal" [Lexeme Name -> Doc
ppLexeme Lexeme Name
val]
    Abs Decl (Lexeme Name)
e                                   -> String -> [Doc] -> Doc
hgo String
"Abs" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
e]
    Max Decl (Lexeme Name)
a Decl (Lexeme Name)
b                                 -> String -> [Doc] -> Doc
hgo String
"Max" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
a, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
b]
    Add Decl (Lexeme Name)
l Decl (Lexeme Name)
r                                 -> String -> [Doc] -> Doc
hgo String
"Add" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
l, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
r]
    Sub Decl (Lexeme Name)
l Decl (Lexeme Name)
r                                 -> String -> [Doc] -> Doc
hgo String
"Sub" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
l, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
r]
    Mul Decl (Lexeme Name)
l Decl (Lexeme Name)
r                                 -> String -> [Doc] -> Doc
hgo String
"Mul" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
l, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
r]
    Div Decl (Lexeme Name)
l Decl (Lexeme Name)
r                                 -> String -> [Doc] -> Doc
hgo String
"Div" [Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
l, Decl (Lexeme Name) -> Doc
ppDecl Decl (Lexeme Name)
r]

ppConstness :: Constness -> Doc
ppConstness :: Constness -> Doc
ppConstness Constness
ConstThis   = String -> Doc
text String
"True"
ppConstness Constness
MutableThis = String -> Doc
text String
"False"

ppGenerated :: Generated -> Doc
ppGenerated :: Generated -> Doc
ppGenerated = String -> Doc
ppCtor (String -> Doc) -> (Generated -> String) -> Generated -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Generated." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (Generated -> String) -> Generated -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generated -> String
forall a. Show a => a -> String
show

ppBuiltinType :: BuiltinType -> Doc
ppBuiltinType :: BuiltinType -> Doc
ppBuiltinType BuiltinType
Void      = String -> Doc
ppCtor String
"Void"
ppBuiltinType BuiltinType
VoidPtr   = String -> Doc
ppCtor String
"VoidPtr"
ppBuiltinType BuiltinType
Bool      = String -> Doc
ppCtor String
"Bool"
ppBuiltinType BuiltinType
Char      = String -> Doc
ppCtor String
"Char"
ppBuiltinType (SInt BitSize
bs) = String -> [Doc] -> Doc
hgo String
"SInt" [BitSize -> Doc
ppBitSize BitSize
bs]
ppBuiltinType (UInt BitSize
bs) = String -> [Doc] -> Doc
hgo String
"UInt" [BitSize -> Doc
ppBitSize BitSize
bs]
ppBuiltinType BuiltinType
SizeT     = String -> Doc
ppCtor String
"SizeT"
ppBuiltinType BuiltinType
String    = String -> Doc
ppCtor String
"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  = String -> Doc
text String
"None"
ppMaybe a -> Doc
f (Just a
x) = a -> Doc
f a
x

ppLexeme :: Lexeme Name -> Doc
ppLexeme :: Lexeme Name -> Doc
ppLexeme (L AlexPosn
_ LexemeClass
c Name
s) = LexemeClass -> Name -> Doc
ppName LexemeClass
c Name
s

ppName :: LexemeClass -> Name -> Doc
ppName :: LexemeClass -> Name -> Doc
ppName LexemeClass
c ([Text]
ns, [Text]
name) = String -> [Doc] -> Doc
hgo String
"Name"
    [ String -> Doc
ppCtor (String -> Doc) -> (LexemeClass -> String) -> LexemeClass -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"LexemeClass." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (LexemeClass -> String) -> LexemeClass -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LexemeClass -> String
forall a. Show a => a -> String
show (LexemeClass -> Doc) -> LexemeClass -> Doc
forall a b. (a -> b) -> a -> b
$ LexemeClass
c
    , (Text -> Doc) -> [Text] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList (String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) [Text]
ns
    , (Text -> Doc) -> [Text] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
ppList (String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) [Text]
name
    ]

renderS :: Doc -> String
renderS :: Doc -> String
renderS = (SimpleDoc -> String -> String) -> String -> SimpleDoc -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip SimpleDoc -> String -> String
displayS String
"" (SimpleDoc -> String) -> (Doc -> SimpleDoc) -> Doc -> String
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 = String -> Text
Text.pack (String -> Text) -> (Doc -> String) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
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