{-# LANGUAGE RecordWildCards #-}
module FFICXX.Generate.Name where

import           Data.Char                         ( toLower )
import           Data.Maybe                        ( fromMaybe, maybe )
import           Data.Monoid                       ( (<>) )
--
import           FFICXX.Generate.Type.Class        ( Accessor(..)
                                                   , Arg(..)
                                                   , Class(..)
                                                   , ClassAlias(caHaskellName,caFFIName)
                                                   , Function(..)
                                                   , TemplateArgType(..)
                                                   , TemplateClass(..)
                                                   , TemplateFunction(..)
                                                   , TemplateMemberFunction(..)
                                                   , TopLevel(..)
                                                   , Variable(..)
                                                   )
import           FFICXX.Generate.Util              ( firstLower, toLowers )



hsFrontNameForTopLevel :: TopLevel -> String
hsFrontNameForTopLevel :: TopLevel -> String
hsFrontNameForTopLevel TopLevel
tfn =
    let (Char
x:String
xs) = case TopLevel
tfn of
                   TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: TopLevel -> Maybe String
toplevelfunc_args :: TopLevel -> [Arg]
toplevelfunc_name :: TopLevel -> String
toplevelfunc_ret :: TopLevel -> Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
..} -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
toplevelfunc_name Maybe String
toplevelfunc_alias
                   TopLevelVariable {String
Maybe String
Types
toplevelvar_alias :: TopLevel -> Maybe String
toplevelvar_name :: TopLevel -> String
toplevelvar_ret :: TopLevel -> Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
..} -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
toplevelvar_name  Maybe String
toplevelvar_alias
    in Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs


typeclassName :: Class -> String
typeclassName :: Class -> String
typeclassName Class
c = Char
'I' Char -> String -> String
forall a. a -> [a] -> [a]
: (String, String) -> String
forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)

typeclassNameT :: TemplateClass -> String
typeclassNameT :: TemplateClass -> String
typeclassNameT TemplateClass
c = Char
'I' Char -> String -> String
forall a. a -> [a] -> [a]
: (String, String) -> String
forall a b. (a, b) -> a
fst (TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
c)



typeclassNameFromStr :: String -> String
typeclassNameFromStr :: String -> String
typeclassNameFromStr = (Char
'I'Char -> String -> String
forall a. a -> [a] -> [a]
:)

hsClassName :: Class -> (String, String)  -- ^ High-level, 'Raw'-level
hsClassName :: Class -> (String, String)
hsClassName Class
c =
  let cname :: String
cname = String -> (ClassAlias -> String) -> Maybe ClassAlias -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Class -> String
class_name Class
c) ClassAlias -> String
caHaskellName (Class -> Maybe ClassAlias
class_alias Class
c)
  in (String
cname, String
"Raw" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname)

hsClassNameForTArg :: TemplateArgType -> String
hsClassNameForTArg :: TemplateArgType -> String
hsClassNameForTArg (TArg_Class Class
c) = (String, String) -> String
forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)
hsClassNameForTArg (TArg_TypeParam String
p) = String
p
hsClassNameForTArg (TArg_Other String
s) = String
s

hsTemplateClassName :: TemplateClass -> (String, String)  -- ^ High-level, 'Raw'-level
hsTemplateClassName :: TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t =
  let tname :: String
tname = TemplateClass -> String
tclass_name TemplateClass
t
  in (String
tname, String
"Raw" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tname)

existConstructorName :: Class -> String
existConstructorName :: Class -> String
existConstructorName Class
c = Char
'E' Char -> String -> String
forall a. a -> [a] -> [a]
: ((String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c


ffiClassName :: Class -> String
ffiClassName :: Class -> String
ffiClassName Class
c = String -> (ClassAlias -> String) -> Maybe ClassAlias -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Class -> String
class_name Class
c) ClassAlias -> String
caFFIName (Class -> Maybe ClassAlias
class_alias Class
c)

hscFuncName :: Class -> Function -> String
hscFuncName :: Class -> Function -> String
hscFuncName Class
c Function
f =    String
"c_"
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
toLowers (Class -> String
ffiClassName Class
c)
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
toLowers (Class -> Function -> String
aliasedFuncName Class
c Function
f)

hsFuncName :: Class -> Function -> String
hsFuncName :: Class -> Function -> String
hsFuncName Class
c Function
f = let (Char
x:String
xs) = Class -> Function -> String
aliasedFuncName Class
c Function
f
                 in (Char -> Char
toLower Char
x) Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

aliasedFuncName :: Class -> Function -> String
aliasedFuncName :: Class -> Function -> String
aliasedFuncName Class
c Function
f =
  case Function
f of
    Constructor [Arg]
_ Maybe String
a      -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Class -> String
constructorName Class
c) Maybe String
a
    Virtual Types
_ String
str [Arg]
_ Maybe String
a    -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
str Maybe String
a
    NonVirtual Types
_ String
str [Arg]
_ Maybe String
a -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Class -> String -> String
nonvirtualName Class
c String
str) Maybe String
a
    Static Types
_ String
str [Arg]
_ Maybe String
a     -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Class -> String -> String
nonvirtualName Class
c String
str) Maybe String
a
    Destructor Maybe String
a         -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
destructorName Maybe String
a

-- |
hsTmplFuncName :: TemplateClass -> TemplateFunction -> String
hsTmplFuncName :: TemplateClass -> TemplateFunction -> String
hsTmplFuncName TemplateClass
t TemplateFunction
f =
  case TemplateFunction
f of
    TFun {String
[Arg]
Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
..}    -> String
tfun_name
    TFunNew {[Arg]
Maybe String
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
..} -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String
"new"String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateClass -> String
tclass_name TemplateClass
t) Maybe String
tfun_new_alias
    TemplateFunction
TFunDelete   -> String
"delete" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateClass -> String
tclass_name TemplateClass
t
    TFunOp {String
OpExp
Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}  -> String
tfun_name

-- |
hsTmplFuncNameTH :: TemplateClass -> TemplateFunction -> String
hsTmplFuncNameTH :: TemplateClass -> TemplateFunction -> String
hsTmplFuncNameTH TemplateClass
t TemplateFunction
f = String
"t_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateClass -> TemplateFunction -> String
hsTmplFuncName TemplateClass
t TemplateFunction
f


hsTemplateMemberFunctionName :: Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName :: Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName Class
c TemplateMemberFunction
f = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Class -> String -> String
nonvirtualName Class
c (TemplateMemberFunction -> String
tmf_name TemplateMemberFunction
f)) (TemplateMemberFunction -> Maybe String
tmf_alias TemplateMemberFunction
f)


hsTemplateMemberFunctionNameTH :: Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionNameTH :: Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionNameTH Class
c TemplateMemberFunction
f = String
"t_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName Class
c TemplateMemberFunction
f


ffiTmplFuncName :: TemplateFunction -> String
ffiTmplFuncName :: TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f =
  case TemplateFunction
f of
    TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}    -> String
tfun_name
    TFunNew {[Arg]
Maybe String
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
..} -> String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"new" Maybe String
tfun_new_alias
    TemplateFunction
TFunDelete   -> String
"delete"
    TFunOp {String
OpExp
Types
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}  -> String
tfun_name

cppTmplFuncName :: TemplateFunction -> String
cppTmplFuncName :: TemplateFunction -> String
cppTmplFuncName TemplateFunction
f =
  case TemplateFunction
f of
    TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}    -> String
tfun_name
    TFunNew {[Arg]
Maybe String
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
..} -> String
"new"
    TemplateFunction
TFunDelete   -> String
"delete"
    TFunOp {String
OpExp
Types
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}  -> String
tfun_name

-- |
accessorName :: Class -> Variable -> Accessor -> String
accessorName :: Class -> Variable -> Accessor -> String
accessorName Class
c Variable
v Accessor
a =    Class -> String -> String
nonvirtualName Class
c (Arg -> String
arg_name (Variable -> Arg
unVariable Variable
v))
                     String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
                     String -> String -> String
forall a. Semigroup a => a -> a -> a
<> case Accessor
a of
                          Accessor
Getter -> String
"get"
                          Accessor
Setter -> String
"set"

-- |
hscAccessorName :: Class -> Variable -> Accessor -> String
hscAccessorName :: Class -> Variable -> Accessor -> String
hscAccessorName Class
c Variable
v Accessor
a = String
"c_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
toLowers (Class -> Variable -> Accessor -> String
accessorName Class
c Variable
v Accessor
a)

-- |
tmplAccessorName :: Variable -> Accessor -> String
tmplAccessorName :: Variable -> Accessor -> String
tmplAccessorName (Variable (Arg Types
_ String
n)) Accessor
a =
     String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> case Accessor
a of { Accessor
Getter -> String
"get"; Accessor
Setter -> String
"set" }

-- |
cppStaticName :: Class -> Function -> String
cppStaticName :: Class -> Function -> String
cppStaticName Class
c Function
f = Class -> String
class_name Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"::" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Function -> String
func_name Function
f

-- |
cppFuncName :: Class -> Function -> String
cppFuncName :: Class -> Function -> String
cppFuncName Class
c Function
f =   case Function
f of
    Constructor [Arg]
_ Maybe String
_ -> String
"new"
    Virtual Types
_ String
_  [Arg]
_ Maybe String
_ -> Function -> String
func_name Function
f
    NonVirtual Types
_ String
_ [Arg]
_ Maybe String
_-> Function -> String
func_name Function
f
    Static Types
_ String
_ [Arg]
_ Maybe String
_-> Class -> Function -> String
cppStaticName Class
c Function
f
    Destructor Maybe String
_ -> String
destructorName

constructorName :: Class -> String
constructorName :: Class -> String
constructorName Class
c = String
"new" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ((String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c

nonvirtualName :: Class -> String -> String
nonvirtualName :: Class -> String -> String
nonvirtualName Class
c String
str = (String -> String
firstLower(String -> String) -> (Class -> String) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str

destructorName :: String
destructorName :: String
destructorName = String
"delete"