{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module FFICXX.Generate.Type.Class where
import Data.List (intercalate)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import FFICXX.Generate.Type.Cabal (Cabal)
data CTypes
= CTBool
| CTChar
| CTClock
| CTDouble
| CTFile
| CTFloat
| CTFpos
| CTInt
| CTIntMax
| CTIntPtr
| CTJmpBuf
| CTLLong
| CTLong
| CTPtrdiff
| CTSChar
| CTSUSeconds
| CTShort
| CTSigAtomic
| CTSize
| CTTime
| CTUChar
| CTUInt
| CTUIntMax
| CTUIntPtr
| CTULLong
| CTULong
| CTUSeconds
| CTUShort
| CTWchar
| CTInt8
| CTInt16
| CTInt32
| CTInt64
| CTUInt8
| CTUInt16
| CTUInt32
| CTUInt64
| CTVoidStar
| CTString
| CEnum CTypes String
| CPointer CTypes
| CRef CTypes
deriving (Int -> CTypes -> ShowS
[CTypes] -> ShowS
CTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CTypes] -> ShowS
$cshowList :: [CTypes] -> ShowS
show :: CTypes -> String
$cshow :: CTypes -> String
showsPrec :: Int -> CTypes -> ShowS
$cshowsPrec :: Int -> CTypes -> ShowS
Show)
data CPPTypes
= CPTClass Class
| CPTClassRef Class
| CPTClassCopy Class
| CPTClassMove Class
deriving (Int -> CPPTypes -> ShowS
[CPPTypes] -> ShowS
CPPTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPPTypes] -> ShowS
$cshowList :: [CPPTypes] -> ShowS
show :: CPPTypes -> String
$cshow :: CPPTypes -> String
showsPrec :: Int -> CPPTypes -> ShowS
$cshowsPrec :: Int -> CPPTypes -> ShowS
Show)
data IsConst = Const | NoConst
deriving (Int -> IsConst -> ShowS
[IsConst] -> ShowS
IsConst -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsConst] -> ShowS
$cshowList :: [IsConst] -> ShowS
show :: IsConst -> String
$cshow :: IsConst -> String
showsPrec :: Int -> IsConst -> ShowS
$cshowsPrec :: Int -> IsConst -> ShowS
Show)
data TemplateArgType
= TArg_Class Class
| TArg_TypeParam String
| TArg_Other String
deriving (Int -> TemplateArgType -> ShowS
[TemplateArgType] -> ShowS
TemplateArgType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateArgType] -> ShowS
$cshowList :: [TemplateArgType] -> ShowS
show :: TemplateArgType -> String
$cshow :: TemplateArgType -> String
showsPrec :: Int -> TemplateArgType -> ShowS
$cshowsPrec :: Int -> TemplateArgType -> ShowS
Show)
data TemplateAppInfo = TemplateAppInfo
{ TemplateAppInfo -> TemplateClass
tapp_tclass :: TemplateClass,
TemplateAppInfo -> [TemplateArgType]
tapp_tparams :: [TemplateArgType],
TemplateAppInfo -> String
tapp_CppTypeForParam :: String
}
deriving (Int -> TemplateAppInfo -> ShowS
[TemplateAppInfo] -> ShowS
TemplateAppInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateAppInfo] -> ShowS
$cshowList :: [TemplateAppInfo] -> ShowS
show :: TemplateAppInfo -> String
$cshow :: TemplateAppInfo -> String
showsPrec :: Int -> TemplateAppInfo -> ShowS
$cshowsPrec :: Int -> TemplateAppInfo -> ShowS
Show)
data Types
= Void
| SelfType
| CT CTypes IsConst
| CPT CPPTypes IsConst
|
TemplateApp TemplateAppInfo
|
TemplateAppRef TemplateAppInfo
|
TemplateAppMove TemplateAppInfo
|
TemplateType TemplateClass
| TemplateParam String
|
TemplateParamPointer String
deriving (Int -> Types -> ShowS
[Types] -> ShowS
Types -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Types] -> ShowS
$cshowList :: [Types] -> ShowS
show :: Types -> String
$cshow :: Types -> String
showsPrec :: Int -> Types -> ShowS
$cshowsPrec :: Int -> Types -> ShowS
Show)
data Arg = Arg
{ Arg -> Types
arg_type :: Types,
Arg -> String
arg_name :: String
}
deriving (Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg] -> ShowS
$cshowList :: [Arg] -> ShowS
show :: Arg -> String
$cshow :: Arg -> String
showsPrec :: Int -> Arg -> ShowS
$cshowsPrec :: Int -> Arg -> ShowS
Show)
data Function
= Constructor
{ Function -> [Arg]
func_args :: [Arg],
Function -> Maybe String
func_alias :: Maybe String
}
| Virtual
{ Function -> Types
func_ret :: Types,
Function -> String
func_name :: String,
func_args :: [Arg],
func_alias :: Maybe String
}
| NonVirtual
{ func_ret :: Types,
func_name :: String,
func_args :: [Arg],
func_alias :: Maybe String
}
| Static
{ func_ret :: Types,
func_name :: String,
func_args :: [Arg],
func_alias :: Maybe String
}
| Destructor
{ func_alias :: Maybe String
}
deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show)
newtype Variable = Variable {Variable -> Arg
unVariable :: Arg}
deriving (Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show)
data TemplateMemberFunction = TemplateMemberFunction
{ TemplateMemberFunction -> [String]
tmf_params :: [String],
TemplateMemberFunction -> Types
tmf_ret :: Types,
TemplateMemberFunction -> String
tmf_name :: String,
TemplateMemberFunction -> [Arg]
tmf_args :: [Arg],
TemplateMemberFunction -> Maybe String
tmf_alias :: Maybe String
}
deriving (Int -> TemplateMemberFunction -> ShowS
[TemplateMemberFunction] -> ShowS
TemplateMemberFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateMemberFunction] -> ShowS
$cshowList :: [TemplateMemberFunction] -> ShowS
show :: TemplateMemberFunction -> String
$cshow :: TemplateMemberFunction -> String
showsPrec :: Int -> TemplateMemberFunction -> ShowS
$cshowsPrec :: Int -> TemplateMemberFunction -> ShowS
Show)
data TopLevel
= TLOrdinary TLOrdinary
| TLTemplate TLTemplate
deriving (Int -> TopLevel -> ShowS
[TopLevel] -> ShowS
TopLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopLevel] -> ShowS
$cshowList :: [TopLevel] -> ShowS
show :: TopLevel -> String
$cshow :: TopLevel -> String
showsPrec :: Int -> TopLevel -> ShowS
$cshowsPrec :: Int -> TopLevel -> ShowS
Show)
filterTLOrdinary :: [TopLevel] -> [TLOrdinary]
filterTLOrdinary :: [TopLevel] -> [TLOrdinary]
filterTLOrdinary = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case TLOrdinary TLOrdinary
f -> forall a. a -> Maybe a
Just TLOrdinary
f; TopLevel
_ -> forall a. Maybe a
Nothing)
filterTLTemplate :: [TopLevel] -> [TLTemplate]
filterTLTemplate :: [TopLevel] -> [TLTemplate]
filterTLTemplate = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case TLTemplate TLTemplate
f -> forall a. a -> Maybe a
Just TLTemplate
f; TopLevel
_ -> forall a. Maybe a
Nothing)
data TLOrdinary
= TopLevelFunction
{ TLOrdinary -> Types
toplevelfunc_ret :: Types,
TLOrdinary -> String
toplevelfunc_name :: String,
TLOrdinary -> [Arg]
toplevelfunc_args :: [Arg],
TLOrdinary -> Maybe String
toplevelfunc_alias :: Maybe String
}
| TopLevelVariable
{ TLOrdinary -> Types
toplevelvar_ret :: Types,
TLOrdinary -> String
toplevelvar_name :: String,
TLOrdinary -> Maybe String
toplevelvar_alias :: Maybe String
}
deriving (Int -> TLOrdinary -> ShowS
[TLOrdinary] -> ShowS
TLOrdinary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TLOrdinary] -> ShowS
$cshowList :: [TLOrdinary] -> ShowS
show :: TLOrdinary -> String
$cshow :: TLOrdinary -> String
showsPrec :: Int -> TLOrdinary -> ShowS
$cshowsPrec :: Int -> TLOrdinary -> ShowS
Show)
data TLTemplate = TopLevelTemplateFunction
{ TLTemplate -> [String]
topleveltfunc_params :: [String],
TLTemplate -> Types
topleveltfunc_ret :: Types,
TLTemplate -> String
topleveltfunc_name :: String,
TLTemplate -> String
topleveltfunc_oname :: String,
TLTemplate -> [Arg]
topleveltfunc_args :: [Arg]
}
deriving (Int -> TLTemplate -> ShowS
[TLTemplate] -> ShowS
TLTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TLTemplate] -> ShowS
$cshowList :: [TLTemplate] -> ShowS
show :: TLTemplate -> String
$cshow :: TLTemplate -> String
showsPrec :: Int -> TLTemplate -> ShowS
$cshowsPrec :: Int -> TLTemplate -> ShowS
Show)
isNewFunc :: Function -> Bool
isNewFunc :: Function -> Bool
isNewFunc (Constructor [Arg]
_ Maybe String
_) = Bool
True
isNewFunc Function
_ = Bool
False
isDeleteFunc :: Function -> Bool
isDeleteFunc :: Function -> Bool
isDeleteFunc (Destructor Maybe String
_) = Bool
True
isDeleteFunc Function
_ = Bool
False
isVirtualFunc :: Function -> Bool
isVirtualFunc :: Function -> Bool
isVirtualFunc (Destructor Maybe String
_) = Bool
True
isVirtualFunc (Virtual Types
_ String
_ [Arg]
_ Maybe String
_) = Bool
True
isVirtualFunc Function
_ = Bool
False
isNonVirtualFunc :: Function -> Bool
isNonVirtualFunc :: Function -> Bool
isNonVirtualFunc (NonVirtual Types
_ String
_ [Arg]
_ Maybe String
_) = Bool
True
isNonVirtualFunc Function
_ = Bool
False
isStaticFunc :: Function -> Bool
isStaticFunc :: Function -> Bool
isStaticFunc (Static Types
_ String
_ [Arg]
_ Maybe String
_) = Bool
True
isStaticFunc Function
_ = Bool
False
virtualFuncs :: [Function] -> [Function]
virtualFuncs :: [Function] -> [Function]
virtualFuncs = forall a. (a -> Bool) -> [a] -> [a]
filter Function -> Bool
isVirtualFunc
constructorFuncs :: [Function] -> [Function]
constructorFuncs :: [Function] -> [Function]
constructorFuncs = forall a. (a -> Bool) -> [a] -> [a]
filter Function -> Bool
isNewFunc
nonVirtualNotNewFuncs :: [Function] -> [Function]
nonVirtualNotNewFuncs :: [Function] -> [Function]
nonVirtualNotNewFuncs =
forall a. (a -> Bool) -> [a] -> [a]
filter (\Function
x -> (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isVirtualFunc) Function
x Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isNewFunc) Function
x Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isDeleteFunc) Function
x Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isStaticFunc) Function
x)
staticFuncs :: [Function] -> [Function]
staticFuncs :: [Function] -> [Function]
staticFuncs = forall a. (a -> Bool) -> [a] -> [a]
filter Function -> Bool
isStaticFunc
newtype ProtectedMethod = Protected {ProtectedMethod -> [String]
unProtected :: [String]}
deriving (NonEmpty ProtectedMethod -> ProtectedMethod
ProtectedMethod -> ProtectedMethod -> ProtectedMethod
forall b. Integral b => b -> ProtectedMethod -> ProtectedMethod
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ProtectedMethod -> ProtectedMethod
$cstimes :: forall b. Integral b => b -> ProtectedMethod -> ProtectedMethod
sconcat :: NonEmpty ProtectedMethod -> ProtectedMethod
$csconcat :: NonEmpty ProtectedMethod -> ProtectedMethod
<> :: ProtectedMethod -> ProtectedMethod -> ProtectedMethod
$c<> :: ProtectedMethod -> ProtectedMethod -> ProtectedMethod
Semigroup, Semigroup ProtectedMethod
ProtectedMethod
[ProtectedMethod] -> ProtectedMethod
ProtectedMethod -> ProtectedMethod -> ProtectedMethod
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ProtectedMethod] -> ProtectedMethod
$cmconcat :: [ProtectedMethod] -> ProtectedMethod
mappend :: ProtectedMethod -> ProtectedMethod -> ProtectedMethod
$cmappend :: ProtectedMethod -> ProtectedMethod -> ProtectedMethod
mempty :: ProtectedMethod
$cmempty :: ProtectedMethod
Monoid)
data ClassAlias = ClassAlias
{ ClassAlias -> String
caHaskellName :: String,
ClassAlias -> String
caFFIName :: String
}
data Class
= Class
{ Class -> Cabal
class_cabal :: Cabal,
Class -> String
class_name :: String,
Class -> [Class]
class_parents :: [Class],
Class -> ProtectedMethod
class_protected :: ProtectedMethod,
Class -> Maybe ClassAlias
class_alias :: Maybe ClassAlias,
Class -> [Function]
class_funcs :: [Function],
Class -> [Variable]
class_vars :: [Variable],
Class -> [TemplateMemberFunction]
class_tmpl_funcs :: [TemplateMemberFunction],
Class -> Bool
class_has_proxy :: Bool
}
| AbstractClass
{ class_cabal :: Cabal,
class_name :: String,
class_parents :: [Class],
class_protected :: ProtectedMethod,
class_alias :: Maybe ClassAlias,
class_funcs :: [Function],
class_vars :: [Variable],
class_tmpl_funcs :: [TemplateMemberFunction]
}
instance Show Class where
show :: Class -> String
show Class
x = forall a. Show a => a -> String
show (Class -> String
class_name Class
x)
instance Eq Class where
== :: Class -> Class -> Bool
(==) Class
x Class
y = Class -> String
class_name Class
x forall a. Eq a => a -> a -> Bool
== Class -> String
class_name Class
y
instance Ord Class where
compare :: Class -> Class -> Ordering
compare Class
x Class
y = forall a. Ord a => a -> a -> Ordering
compare (Class -> String
class_name Class
x) (Class -> String
class_name Class
y)
data OpExp
=
OpStar
|
OpFPPlus
data TemplateFunction
= TFun
{ TemplateFunction -> Types
tfun_ret :: Types,
TemplateFunction -> String
tfun_name :: String,
TemplateFunction -> String
tfun_oname :: String,
TemplateFunction -> [Arg]
tfun_args :: [Arg]
}
| TFunNew
{ TemplateFunction -> [Arg]
tfun_new_args :: [Arg],
TemplateFunction -> Maybe String
tfun_new_alias :: Maybe String
}
| TFunDelete
| TFunOp
{ tfun_ret :: Types,
tfun_name :: String,
TemplateFunction -> OpExp
tfun_opexp :: OpExp
}
argsFromOpExp :: OpExp -> [Arg]
argsFromOpExp :: OpExp -> [Arg]
argsFromOpExp OpExp
OpStar = []
argsFromOpExp OpExp
OpFPPlus = []
opSymbol :: OpExp -> String
opSymbol :: OpExp -> String
opSymbol OpExp
OpStar = String
"*"
opSymbol OpExp
OpFPPlus = String
"++"
data Form
= FormSimple String
| FormNested String String
data TemplateClass = TmplCls
{ TemplateClass -> Cabal
tclass_cabal :: Cabal,
TemplateClass -> String
tclass_name :: String,
TemplateClass -> Form
tclass_cxxform :: Form,
TemplateClass -> [String]
tclass_params :: [String],
TemplateClass -> [TemplateFunction]
tclass_funcs :: [TemplateFunction],
TemplateClass -> [Variable]
tclass_vars :: [Variable]
}
instance Show TemplateClass where
show :: TemplateClass -> String
show TemplateClass
x = forall a. Show a => a -> String
show (TemplateClass -> String
tclass_name TemplateClass
x forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
" " (TemplateClass -> [String]
tclass_params TemplateClass
x))
instance Eq TemplateClass where
== :: TemplateClass -> TemplateClass -> Bool
(==) TemplateClass
x TemplateClass
y = TemplateClass -> String
tclass_name TemplateClass
x forall a. Eq a => a -> a -> Bool
== TemplateClass -> String
tclass_name TemplateClass
y
instance Ord TemplateClass where
compare :: TemplateClass -> TemplateClass -> Ordering
compare TemplateClass
x TemplateClass
y = forall a. Ord a => a -> a -> Ordering
compare (TemplateClass -> String
tclass_name TemplateClass
x) (TemplateClass -> String
tclass_name TemplateClass
y)
data ClassGlobal = ClassGlobal
{ ClassGlobal -> DaughterMap
cgDaughterSelfMap :: DaughterMap,
ClassGlobal -> DaughterMap
cgDaughterMap :: DaughterMap
}
data Selfness = Self | NoSelf
isAbstractClass :: Class -> Bool
isAbstractClass :: Class -> Bool
isAbstractClass Class {} = Bool
False
isAbstractClass AbstractClass {} = Bool
True
hasProxy :: Class -> Bool
hasProxy :: Class -> Bool
hasProxy c :: Class
c@Class {} = Class -> Bool
class_has_proxy Class
c
hasProxy AbstractClass {} = Bool
False
type DaughterMap = M.Map String [Class]
data Accessor = Getter | Setter
deriving (Int -> Accessor -> ShowS
[Accessor] -> ShowS
Accessor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accessor] -> ShowS
$cshowList :: [Accessor] -> ShowS
show :: Accessor -> String
$cshow :: Accessor -> String
showsPrec :: Int -> Accessor -> ShowS
$cshowsPrec :: Int -> Accessor -> ShowS
Show, Accessor -> Accessor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accessor -> Accessor -> Bool
$c/= :: Accessor -> Accessor -> Bool
== :: Accessor -> Accessor -> Bool
$c== :: Accessor -> Accessor -> Bool
Eq)