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

-----------------------------------------------------------------------------
-- |
-- Module      : FFICXX.Generate.Code.Cpp
-- Copyright   : (c) 2011-2016 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------

module FFICXX.Generate.Code.Cpp where

import           Data.Char 
import           Data.Monoid                           ( (<>) )
--
import           FFICXX.Generate.Util
import           FFICXX.Generate.Code.MethodDef
import           FFICXX.Generate.Type.Class
import           FFICXX.Generate.Type.Module
import           FFICXX.Generate.Type.PackageInterface
--

--
-- Class Declaration and Definition
--

----
---- Declaration
----

---- "Class Type Declaration" Instances

genCppHeaderTmplType :: Class -> String 
genCppHeaderTmplType c = let tmpl = "// Opaque type definition for $classname \n\
                                    \typedef struct ${classname}_tag ${classname}_t; \n\
                                    \typedef ${classname}_t * ${classname}_p; \n\
                                    \typedef ${classname}_t const* const_${classname}_p; \n"
                      in subst tmpl (context [ ("classname", class_name c) ])

genAllCppHeaderTmplType :: [Class] -> String
genAllCppHeaderTmplType = intercalateWith connRet2 (genCppHeaderTmplType) 

---- "Class Declaration Virtual" Declaration 

genCppHeaderTmplVirtual :: Class -> String 
genCppHeaderTmplVirtual aclass =  
  let tmpl = "#undef ${classname}_DECL_VIRT \n#define ${classname}_DECL_VIRT(Type) \\\n${funcdecl}"
      funcDeclStr = (funcsToDecls aclass) . virtualFuncs . class_funcs $ aclass
  in subst tmpl (context [ ("classname", map toUpper (class_name aclass) ) 
                         , ("funcdecl" , funcDeclStr                     ) ]) 
      
genAllCppHeaderTmplVirtual :: [Class] -> String 
genAllCppHeaderTmplVirtual = intercalateWith connRet2 genCppHeaderTmplVirtual

---- "Class Declaration Non-Virtual" Declaration

genCppHeaderTmplNonVirtual :: Class -> String
genCppHeaderTmplNonVirtual c = 
  let tmpl = "#undef ${classname}_DECL_NONVIRT \n#define ${classname}_DECL_NONVIRT(Type) \\\n$funcdecl" 
      declBodyStr = subst tmpl (context [ ("classname", map toUpper (class_name c))
                                        , ("funcdecl" , funcDeclStr               ) ])
      funcDeclStr = (funcsToDecls c) . filter (not.isVirtualFunc) 
                                     . class_funcs $ c
  in  declBodyStr 

genAllCppHeaderTmplNonVirtual :: [Class] -> String 
genAllCppHeaderTmplNonVirtual = intercalateWith connRet genCppHeaderTmplNonVirtual

---- "Class Declaration Virtual/NonVirtual" Instances

genCppHeaderInstVirtual :: (Class,Class) -> String 
genCppHeaderInstVirtual (p,c) = 
  let strc = map toUpper (class_name p) 
  in  strc<>"_DECL_VIRT(" <> class_name c <> ");\n"

genCppHeaderInstNonVirtual :: Class -> String 
genCppHeaderInstNonVirtual c = 
  let strx = map toUpper (class_name c) 
  in  strx<>"_DECL_NONVIRT(" <> class_name c <> ");\n" 

genAllCppHeaderInstNonVirtual :: [Class] -> String 
genAllCppHeaderInstNonVirtual = 
  intercalateWith connRet genCppHeaderInstNonVirtual


----
---- Definition
----

---- "Class Definition Virtual" Declaration

genCppDefTmplVirtual :: Class -> String 
genCppDefTmplVirtual aclass =  
  let tmpl = "#undef ${classname}_DEF_VIRT\n#define ${classname}_DEF_VIRT(Type)\\\n$funcdef" 
      defBodyStr = subst tmpl (context [ ("classname", map toUpper (class_name aclass) ) 
                                       , ("funcdef"  , funcDefStr                      ) ]) 
      funcDefStr = (funcsToDefs aclass) . virtualFuncs . class_funcs $ aclass
  in  defBodyStr 
      
genAllCppDefTmplVirtual :: [Class] -> String
genAllCppDefTmplVirtual = intercalateWith connRet2 genCppDefTmplVirtual

---- "Class Definition NonVirtual" Declaration

genCppDefTmplNonVirtual :: Class -> String 
genCppDefTmplNonVirtual aclass =  
  let tmpl = "#undef ${classname}_DEF_NONVIRT\n#define ${classname}_DEF_NONVIRT(Type)\\\n$funcdef" 
      defBodyStr = subst tmpl (context [ ("classname", map toUpper (class_name aclass) ) 
                                       , ("funcdef"  , funcDefStr                      ) ]) 
      funcDefStr = (funcsToDefs aclass) . filter (not.isVirtualFunc) 
                                        . class_funcs $ aclass
  in  defBodyStr 
      
genAllCppDefTmplNonVirtual :: [Class] -> String
genAllCppDefTmplNonVirtual = intercalateWith connRet2 genCppDefTmplNonVirtual

---- "Class Definition Virtual/NonVirtual" Instances

genCppDefInstVirtual :: (Class,Class) -> String 
genCppDefInstVirtual (p,c) = 
  let strc = map toUpper (class_name p) 
  in  strc<>"_DEF_VIRT(" <> class_name c <> ")\n"

genCppDefInstNonVirtual :: Class -> String
genCppDefInstNonVirtual c = 
  subst "${capitalclassname}_DEF_NONVIRT(${classname})"
    (context [ ("capitalclassname", toUppers (class_name c))
             , ("classname"       , class_name c           ) ]) 

genAllCppDefInstNonVirtual :: [Class] -> String 
genAllCppDefInstNonVirtual = intercalateWith connRet genCppDefInstNonVirtual

-----------------

genAllCppHeaderInclude :: ClassImportHeader -> String 
genAllCppHeaderInclude header = 
    intercalateWith connRet (\x->"#include \""<>x<>"\"") $
      map unHdrName (cihIncludedHPkgHeadersInCPP header
                     <> cihIncludedCPkgHeaders header)

----



-------------------------
-- TOP LEVEL FUNCTIONS --
-------------------------

genTopLevelFuncCppHeader :: TopLevelFunction -> String 
genTopLevelFuncCppHeader TopLevelFunction {..} = 
  subst "$returntype $funcname ( $args );" 
    (context [ ("returntype", rettypeToString toplevelfunc_ret                )  
             , ("funcname"  , "TopLevel_" 
                              <> maybe toplevelfunc_name id toplevelfunc_alias)
             , ("args"      , argsToStringNoSelf toplevelfunc_args            ) ])
genTopLevelFuncCppHeader TopLevelVariable {..} = 
  subst "$returntype $funcname ( );"
    (context [ ("returntype", rettypeToString toplevelvar_ret                )  
             , ("funcname"  , "TopLevel_" 
                               <> maybe toplevelvar_name id toplevelvar_alias) ]) 

genTopLevelFuncCppDefinition :: TopLevelFunction -> String 
genTopLevelFuncCppDefinition TopLevelFunction {..} =  
  let tmpl = "$returntype $funcname ( $args ) { \n  $funcbody\n}" 
      callstr = toplevelfunc_name <> "("
                <> argsToCallString toplevelfunc_args   
                <> ")"
      funcDefStr = returnCpp False (toplevelfunc_ret) callstr
  in subst tmpl (context [ ("returntype", rettypeToString toplevelfunc_ret                )  
                         , ("funcname"  , "TopLevel_" 
                                          <> maybe toplevelfunc_name id toplevelfunc_alias)
                         , ("args"      , argsToStringNoSelf toplevelfunc_args            ) 
                         , ("funcbody"  , funcDefStr                                      ) ])
genTopLevelFuncCppDefinition TopLevelVariable {..} =  
  let tmpl = "$returntype $funcname ( ) { \n  $funcbody\n}" 
      callstr = toplevelvar_name
      funcDefStr = returnCpp False (toplevelvar_ret) callstr
  in subst tmpl (context [ ("returntype", rettypeToString toplevelvar_ret               )  
                         , ("funcname"  , "TopLevel_" 
                                          <> maybe toplevelvar_name id toplevelvar_alias)
                         , ("funcbody"  , funcDefStr                                    ) ])


genTmplFunCpp :: Bool -- ^ is for simple type?
              -> TemplateClass
              -> TemplateFunction
              -> String 
genTmplFunCpp b t@TmplCls {..} f = subst tmpl ctxt
 where
  tmpl = "#define ${tname}_${fname}${suffix}(Type) \\\n\
         \  extern \"C\" { \\\n\
         \    $decl; \\\n\
         \  } \\\n\
         \  inline $defn \\\n\
         \  auto a_${tname}_${fname}_ ## Type = ${tname}_${fname}_ ## Type  ;\n"
  ctxt = context . (("suffix",if b then "_s" else ""):) $
                   case f of
                     TFunNew {..} -> [ ("tname"  , tclass_name       )
                                     , ("fname"  , "new"             )
                                     , ("decl"   , tmplFunToDecl b t f )
                                     , ("defn"   , tmplFunToDef b t f  ) ]
                     TFun {..}    -> [ ("tname"  , tclass_name       )
                                     , ("fname"  , tfun_name         )
                                     , ("decl"   , tmplFunToDecl b t f )
                                     , ("defn"   , tmplFunToDef b t f  ) ]
                     TFunDelete   -> [ ("tname"  , tclass_name       )
                                     , ("fname"  , "delete"          )
                                     , ("decl"   , tmplFunToDecl b t f )
                                     , ("defn"   , tmplFunToDef b t f  ) ]

genTmplClassCpp :: Bool -- ^ is for simple type
                -> TemplateClass
                -> [TemplateFunction]
                -> String 
genTmplClassCpp b TmplCls {..} fs = subst tmpl ctxt
 where
  tmpl = "#define ${tname}_instance${suffix}(Type) \\\n\
         \$macro\n"
  suffix = if b then "_s" else ""
  ctxt = context [ ("tname"  , tclass_name )
                 , ("suffix" , suffix      ) 
                 , ("macro"  , macro       ) ]
  tname = tclass_name
  
  macro1 TFun {..}    = "  " <> tname<> "_" <> tfun_name <> suffix <> "(Type) \\"
                 
  macro1 TFunNew {..} = "  " <> tname<> "_new(Type) \\"
  macro1 TFunDelete   = "  " <> tname<> "_delete(Type) \\"                 
  macro = intercalateWith connRet macro1 fs