{-# LANGUAGE RecordWildCards #-}

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

module FFICXX.Generate.Code.Dependency where

--
-- fficxx generates one module per one C++ class, and C++ class depends on other classes,
-- so we need to import other modules corresponding to C++ classes in the dependency list.
-- Calculating the import list from dependency graph is what this module does.

-- Previously, we have only `Class` type, but added `TemplateClass` recently. Therefore
-- we have to calculate dependency graph for both types of classes. So we needed to change
-- `Class` to `Either TemplateClass Class` in many of routines that calculates module import
-- list.

-- `Dep4Func` contains a list of classes (both ordinary and template types) that is needed
-- for the definition of a member function.
-- The goal of `extractClassDep...` functions are to extract Dep4Func, and from the definition
-- of a class or a template class, we get a list of `Dep4Func`s and then we deduplicate the
-- dependency class list and finally get the import list for the module corresponding to
-- a given class.   
-- 

import           Data.Either               ( rights )
import           Data.Function             ( on )
import qualified Data.HashMap.Strict as HM
import           Data.List 
import           Data.Maybe
import           Data.Monoid               ( (<>) )
import           System.FilePath 
--
import           FFICXX.Generate.Type.Class
import           FFICXX.Generate.Type.Module
import           FFICXX.Generate.Type.PackageInterface
--
import           Debug.Trace


-- utility functions

getclassname = either tclass_name class_name

getcabal = either tclass_cabal class_cabal

getparents = either (const []) (map Right . class_parents) 

getmodulebase = either getTClassModuleBase getClassModuleBase

-- |
extractClassFromType :: Types -> Maybe (Either TemplateClass Class)
extractClassFromType Void                     = Nothing
extractClassFromType SelfType                 = Nothing
extractClassFromType (CT _ _)                 = Nothing
extractClassFromType (CPT (CPTClass c) _)     = Just (Right c)
extractClassFromType (CPT (CPTClassRef c) _)  = Just (Right c)
extractClassFromType (CPT (CPTClassCopy c) _) = Just (Right c)
extractClassFromType (TemplateApp t _ _)      = Just (Left t)
extractClassFromType (TemplateAppRef t _ _)   = Just (Left t)
extractClassFromType (TemplateType t)         = Just (Left t)
extractClassFromType (TemplateParam _)        = Nothing


-- | class dependency for a given function 
data Dep4Func = Dep4Func { returnDependency :: Maybe (Either TemplateClass Class)
                         , argumentDependency :: [(Either TemplateClass Class)] }


-- | 
extractClassDep :: Function -> Dep4Func 
extractClassDep (Constructor args _)  = Dep4Func Nothing (catMaybes (map (extractClassFromType.fst) args))
extractClassDep (Virtual ret _ args _) = 
    Dep4Func (extractClassFromType ret) (mapMaybe (extractClassFromType.fst) args)
extractClassDep (NonVirtual ret _ args _) =
    Dep4Func (extractClassFromType ret) (mapMaybe (extractClassFromType.fst) args)
extractClassDep (Static ret _ args _) = 
    Dep4Func (extractClassFromType ret) (mapMaybe (extractClassFromType.fst) args)
extractClassDep (Destructor _) = 
    Dep4Func Nothing [] 


extractClassDepForTmplFun :: TemplateFunction -> Dep4Func 
extractClassDepForTmplFun (TFun ret  _ _ args _) = 
    Dep4Func (extractClassFromType ret) (mapMaybe (extractClassFromType.fst) args)
extractClassDepForTmplFun (TFunNew args) =
    Dep4Func Nothing (mapMaybe (extractClassFromType.fst) args)
extractClassDepForTmplFun TFunDelete = Dep4Func Nothing [] 


extractClassDepForTopLevelFunction :: TopLevelFunction -> Dep4Func 
extractClassDepForTopLevelFunction f = 
    Dep4Func (extractClassFromType ret) (mapMaybe (extractClassFromType.fst) args)
  where ret = case f of 
                TopLevelFunction {..} -> toplevelfunc_ret
                TopLevelVariable {..} -> toplevelvar_ret
        args = case f of
                 TopLevelFunction {..} -> toplevelfunc_args
                 TopLevelVariable {..} -> [] 


-- | 
mkModuleDepRaw :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepRaw x@(Right c)
  = (nub . filter (/= x) . mapMaybe (returnDependency.extractClassDep) . class_funcs) c
mkModuleDepRaw x@(Left t)
  = (nub . filter (/= x) . mapMaybe (returnDependency.extractClassDepForTmplFun) . tclass_funcs) t


-- | 
mkModuleDepHighNonSource :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepHighNonSource y@(Right c) = 
  let fs = class_funcs c 
      pkgname = (cabal_pkgname . class_cabal) c
      extclasses = (filter (\x-> x /= y && ((/= pkgname) . cabal_pkgname . getcabal) x) . concatMap (argumentDependency.extractClassDep)) fs
      parents = map Right (class_parents c)
  in  nub (parents <> extclasses) 
mkModuleDepHighNonSource y@(Left t) = 
  let fs = tclass_funcs t 
      pkgname = (cabal_pkgname . tclass_cabal) t 
      extclasses = (filter (\x-> x /= y && ((/= pkgname) . cabal_pkgname . getcabal) x) . concatMap (argumentDependency.extractClassDepForTmplFun)) fs
      -- parents = class_parents c 
  in  nub extclasses


-- | 
mkModuleDepHighSource :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepHighSource y@(Right c) = 
  let fs = class_funcs c 
      pkgname = (cabal_pkgname . class_cabal) c 
  in  nub . filter (\x-> x /= y && not (x `elem` getparents y) && (((== pkgname) . cabal_pkgname . getcabal) x)) . concatMap (argumentDependency.extractClassDep) $ fs
mkModuleDepHighSource y@(Left t) = 
  let fs = tclass_funcs t
      pkgname = (cabal_pkgname . tclass_cabal) t
  in  nub . filter (\x-> x /= y && not (x `elem` getparents y) && (((== pkgname) . cabal_pkgname . getcabal) x)) . concatMap (argumentDependency.extractClassDepForTmplFun) $ fs

-- | 
mkModuleDepCpp :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepCpp y@(Right c) = 
  let fs = class_funcs c 
  in  nub . filter (/= y)  $ 
        mapMaybe (returnDependency.extractClassDep) fs   
        <> concatMap (argumentDependency.extractClassDep) fs
        <> getparents y
mkModuleDepCpp y@(Left t) = 
  let fs = tclass_funcs t
  in  nub . filter (/= y)  $ 
        mapMaybe (returnDependency.extractClassDepForTmplFun) fs   
        <> concatMap (argumentDependency.extractClassDepForTmplFun) fs
        <> getparents y

-- | 
mkModuleDepFFI4One :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepFFI4One (Right c) = 
  let fs = class_funcs c 
  in mapMaybe (returnDependency.extractClassDep) fs <> concatMap (argumentDependency.extractClassDep) fs 
mkModuleDepFFI4One (Left t) = 
  let fs = tclass_funcs t 
  in mapMaybe (returnDependency.extractClassDepForTmplFun) fs <>
     concatMap (argumentDependency.extractClassDepForTmplFun) fs 


-- | 
mkModuleDepFFI :: Either TemplateClass Class -> [Either TemplateClass Class] 
mkModuleDepFFI y@(Right c) = 
  let ps = map Right (class_allparents c)
      alldeps' = (concatMap mkModuleDepFFI4One ps) <> mkModuleDepFFI4One y
  in nub (filter (/= y) alldeps')
mkModuleDepFFI y@(Left t) = [] 

     
mkClassModule :: (Class->([Namespace],[HeaderName]))
              -> [(String,[String])]
              -> Class 
              -> ClassModule 
mkClassModule mkincheaders extra c =
  ClassModule (getClassModuleBase c) [c] (map (mkCIH mkincheaders) [c]) highs_nonsource
              raws highs_source ffis extraimports

  where highs_nonsource = (map getmodulebase . mkModuleDepHighNonSource) (Right c)
        raws = (map getmodulebase . mkModuleDepRaw) (Right c)
        highs_source = (map getmodulebase . mkModuleDepHighSource) (Right c)
        ffis = (map getmodulebase . mkModuleDepFFI) (Right c)
        extraimports = fromMaybe [] (lookup (class_name c) extra)



mkClassNSHeaderFromMap :: HM.HashMap String ([Namespace],[HeaderName]) -> Class -> ([Namespace],[HeaderName])
mkClassNSHeaderFromMap m c = fromMaybe ([],[]) (HM.lookup (class_name c) m)


mkTCM :: (TemplateClass,HeaderName) -> TemplateClassModule 
mkTCM (t,hdr) = TCM  (getTClassModuleBase t) [t] [TCIH t hdr]


mkPackageConfig
  :: (String,Class->([Namespace],[HeaderName])) -- ^ (package name,mkIncludeHeaders)
  -> ([Class],[TopLevelFunction],[(TemplateClass,HeaderName)],[(String,[String])])
  -> [AddCInc]
  -> [AddCSrc]
  -> PackageConfig
mkPackageConfig (pkgname,mkNS_IncHdrs) (cs,fs,ts,extra) acincs acsrcs = 
  let ms = map (mkClassModule mkNS_IncHdrs extra) cs 
      cmpfunc x y = class_name (cihClass x) == class_name (cihClass y)
      cihs = nubBy cmpfunc (concatMap cmCIH ms)
      -- for toplevel 
      tl_cs1 = concatMap (argumentDependency . extractClassDepForTopLevelFunction) fs 
      tl_cs2 = mapMaybe (returnDependency . extractClassDepForTopLevelFunction) fs 
      tl_cs = nubBy ((==) `on` getclassname) (tl_cs1 <> tl_cs2)
      tl_cihs = catMaybes $ 
        foldr (\c acc-> (find (\x -> (class_name . cihClass) x == getclassname c) cihs):acc) [] tl_cs 
      -- 
      tih = TopLevelImportHeader (pkgname <> "TopLevel") tl_cihs fs
      tcms = map mkTCM ts
      tcihs = concatMap tcmTCIH tcms
  in PkgConfig ms cihs tih tcms tcihs acincs acsrcs


mkHSBOOTCandidateList :: [ClassModule] -> [String]
mkHSBOOTCandidateList ms = nub (concatMap cmImportedModulesHighSource ms)

-- | 
mkPkgHeaderFileName ::Class -> HeaderName
mkPkgHeaderFileName c = 
    HdrName ((cabal_cheaderprefix.class_cabal) c <> class_name c <.> "h")

-- | 
mkPkgCppFileName ::Class -> String 
mkPkgCppFileName c = 
    (cabal_cheaderprefix.class_cabal) c <> class_name c <.> "cpp"

-- | 
mkPkgIncludeHeadersInH :: Class -> [HeaderName]
mkPkgIncludeHeadersInH c =
    let pkgname = (cabal_pkgname . class_cabal) c
        extclasses = (filter ((/= pkgname) . cabal_pkgname . getcabal) . mkModuleDepCpp) (Right c)
        extheaders = nub . map ((<>"Type.h") .  cabal_pkgname . getcabal) $ extclasses  
    in map mkPkgHeaderFileName (class_allparents c) <> map HdrName extheaders

                           

-- | 
mkPkgIncludeHeadersInCPP :: Class -> [HeaderName]
mkPkgIncludeHeadersInCPP = map mkPkgHeaderFileName . rights . mkModuleDepCpp . Right


-- | 
mkCIH :: (Class->([Namespace],[HeaderName]))  -- ^ (mk namespace and include headers)  
      -> Class 
      -> ClassImportHeader
mkCIH mkNSandIncHdrs c = ClassImportHeader c 
                           (mkPkgHeaderFileName c) 
                           ((fst . mkNSandIncHdrs) c)
                           (mkPkgCppFileName c) 
                           (mkPkgIncludeHeadersInH c) 
                           (mkPkgIncludeHeadersInCPP c)
                           ((snd . mkNSandIncHdrs) c)