{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.Code.HsFFI where

import Data.Maybe                   ( fromMaybe, mapMaybe )
import Data.Monoid                  ( (<>) )
import Language.Haskell.Exts.Syntax ( Decl(..), ImportDecl(..) )
import System.FilePath              ( (<.>) )
--
import FFICXX.Runtime.CodeGen.Cxx   ( HeaderName(..) )
--
import FFICXX.Generate.Code.Primitive
                                    ( CFunSig(..)
                                    , accessorCFunSig
                                    , genericFuncArgs
                                    , genericFuncRet
                                    , hsFFIFuncTyp
                                    )
import FFICXX.Generate.Dependency   ( class_allparents
                                    , getClassModuleBase
                                    , getTClassModuleBase
                                    )
import FFICXX.Generate.Name         ( aliasedFuncName
                                    , ffiClassName
                                    , hscAccessorName
                                    , hscFuncName
                                    )
import FFICXX.Generate.Type.Class   ( Accessor(Getter,Setter)
                                    , Arg(..)
                                    , Class(..)
                                    , Function(..)
                                    , Selfness(NoSelf,Self)
                                    , TopLevel(..)
                                    , Variable(unVariable)
                                    , isAbstractClass
                                    , isNewFunc
                                    , isStaticFunc
                                    , virtualFuncs
                                    )
import FFICXX.Generate.Type.Module  ( ClassImportHeader(..)
                                    , ClassModule(..)
                                    , TopLevelImportHeader(..)
                                    )
import FFICXX.Generate.Util         ( toLowers )
import FFICXX.Generate.Util.HaskellSrcExts ( mkForImpCcall, mkImport )


genHsFFI :: ClassImportHeader -> [Decl ()]
genHsFFI :: ClassImportHeader -> [Decl ()]
genHsFFI ClassImportHeader
header =
  let c :: Class
c = ClassImportHeader -> Class
cihClass ClassImportHeader
header
      -- TODO: This C header information should not be necessary according to up-to-date
      --       version of Haskell FFI.
      h :: HeaderName
h = ClassImportHeader -> HeaderName
cihSelfHeader ClassImportHeader
header
      -- NOTE: We need to generate FFI both for member functions at the current class level
      --       and parent level. For example, consider a class A with method foo, which a
      --       subclass of B with method bar. Then, A::foo (c_a_foo) and A::bar (c_a_bar)
      --       are made into a FFI function.
      allfns :: [Function]
allfns =    (Class -> [Function]) -> [Class] -> [Function]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Function] -> [Function]
virtualFuncs ([Function] -> [Function])
-> (Class -> [Function]) -> Class -> [Function]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs)
                            (Class -> [Class]
class_allparents Class
c)
               [Function] -> [Function] -> [Function]
forall a. Semigroup a => a -> a -> a
<> (Class -> [Function]
class_funcs Class
c)

  in    (Function -> Maybe (Decl ())) -> [Function] -> [Decl ()]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HeaderName -> Class -> Function -> Maybe (Decl ())
hsFFIClassFunc HeaderName
h Class
c) [Function]
allfns
     [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. Semigroup a => a -> a -> a
<> (Variable -> [Decl ()]) -> [Variable] -> [Decl ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\Variable
v -> [Class -> Variable -> Accessor -> Decl ()
hsFFIAccessor Class
c Variable
v Accessor
Getter, Class -> Variable -> Accessor -> Decl ()
hsFFIAccessor Class
c Variable
v Accessor
Setter])
          (Class -> [Variable]
class_vars Class
c)

hsFFIClassFunc :: HeaderName -> Class -> Function -> Maybe (Decl ())
hsFFIClassFunc :: HeaderName -> Class -> Function -> Maybe (Decl ())
hsFFIClassFunc HeaderName
headerfilename Class
c Function
f =
  if Class -> Bool
isAbstractClass Class
c
  then Maybe (Decl ())
forall a. Maybe a
Nothing
  else let hfile :: String
hfile = HeaderName -> String
unHdrName HeaderName
headerfilename
           -- TODO: Make this a separate function
           cname :: String
cname = 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
<> Class -> Function -> String
aliasedFuncName Class
c Function
f
           csig :: CFunSig
csig = [Arg] -> Types -> CFunSig
CFunSig (Function -> [Arg]
genericFuncArgs Function
f) (Function -> Types
genericFuncRet Function
f)
           typ :: Type ()
typ = if (Function -> Bool
isNewFunc Function
f Bool -> Bool -> Bool
|| Function -> Bool
isStaticFunc Function
f)
                 then Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp ((Selfness, Class) -> Maybe (Selfness, Class)
forall a. a -> Maybe a
Just (Selfness
NoSelf,Class
c)) CFunSig
csig
                 else Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp ((Selfness, Class) -> Maybe (Selfness, Class)
forall a. a -> Maybe a
Just (Selfness
Self,Class
c)  ) CFunSig
csig
       in Decl () -> Maybe (Decl ())
forall a. a -> Maybe a
Just (String -> String -> Type () -> Decl ()
mkForImpCcall (String
hfile String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname) (Class -> Function -> String
hscFuncName Class
c Function
f) Type ()
typ)


hsFFIAccessor ::Class -> Variable -> Accessor -> Decl ()
hsFFIAccessor :: Class -> Variable -> Accessor -> Decl ()
hsFFIAccessor Class
c Variable
v Accessor
a =
  let -- TODO: make this a separate function
      cname :: String
cname = 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
<> 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")
      typ :: Type ()
typ = Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp ((Selfness, Class) -> Maybe (Selfness, Class)
forall a. a -> Maybe a
Just (Selfness
Self,Class
c)) (Types -> Accessor -> CFunSig
accessorCFunSig (Arg -> Types
arg_type (Variable -> Arg
unVariable  Variable
v)) Accessor
a)
  in String -> String -> Type () -> Decl ()
mkForImpCcall String
cname (Class -> Variable -> Accessor -> String
hscAccessorName Class
c Variable
v Accessor
a) Type ()
typ


-- import for FFI

genImportInFFI :: ClassModule -> [ImportDecl ()]
genImportInFFI :: ClassModule -> [ImportDecl ()]
genImportInFFI = (Either TemplateClass Class -> ImportDecl ())
-> [Either TemplateClass Class] -> [ImportDecl ()]
forall a b. (a -> b) -> [a] -> [b]
map Either TemplateClass Class -> ImportDecl ()
mkMod ([Either TemplateClass Class] -> [ImportDecl ()])
-> (ClassModule -> [Either TemplateClass Class])
-> ClassModule
-> [ImportDecl ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassModule -> [Either TemplateClass Class]
cmImportedModulesForFFI
  where mkMod :: Either TemplateClass Class -> ImportDecl ()
mkMod (Left TemplateClass
t)  = String -> ImportDecl ()
mkImport (TemplateClass -> String
getTClassModuleBase TemplateClass
t String -> String -> String
<.> String
"Template")
        mkMod (Right Class
c) = String -> ImportDecl ()
mkImport (Class -> String
getClassModuleBase Class
c String -> String -> String
<.> String
"RawType")


----------------------------
-- for top level function --
----------------------------

genTopLevelFFI :: TopLevelImportHeader -> TopLevel -> Decl ()
genTopLevelFFI :: TopLevelImportHeader -> TopLevel -> Decl ()
genTopLevelFFI TopLevelImportHeader
header TopLevel
tfn = String -> String -> Type () -> Decl ()
mkForImpCcall (String
hfilename String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" TopLevel_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fname) String
cfname Type ()
typ
  where (String
fname,[Arg]
args,Types
ret) =
          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, [Arg]
toplevelfunc_args, Types
toplevelfunc_ret)
            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, [], Types
toplevelvar_ret)
        hfilename :: String
hfilename = TopLevelImportHeader -> String
tihHeaderFileName TopLevelImportHeader
header String -> String -> String
<.> String
"h"
        -- TODO: This must be exposed as a top-level function
        cfname :: String
cfname = String
"c_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
toLowers String
fname
        typ :: Type ()
typ =Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp Maybe (Selfness, Class)
forall a. Maybe a
Nothing ([Arg] -> Types -> CFunSig
CFunSig [Arg]
args Types
ret)