{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.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         ( find, foldl', nub, nubBy )
import qualified Data.Map as M
import           Data.Maybe        ( catMaybes, fromMaybe, mapMaybe )
import           Data.Monoid       ( (<>) )
import           System.FilePath   ( (<.>) )
--
import FFICXX.Runtime.CodeGen.Cxx  ( HeaderName(..) )
--
import FFICXX.Generate.Name        ( ffiClassName, hsClassName, hsTemplateClassName )
import FFICXX.Generate.Type.Cabal  ( AddCInc,AddCSrc,CabalName(..)
                                   , cabal_moduleprefix, cabal_pkgname
                                   , cabal_cheaderprefix, unCabalName
                                   )
import FFICXX.Generate.Type.Class  ( Arg(..)
                                   , Class(..)
                                   , CPPTypes(..)
                                   , DaughterMap
                                   , Function(..)
                                   , TemplateAppInfo(..)
                                   , TemplateArgType(TArg_Class)
                                   , TemplateClass(..)
                                   , TemplateFunction(..)
                                   , TemplateMemberFunction(..)
                                   , TopLevel(..)
                                   , Types(..)
                                   , Variable(unVariable)
                                   , argsFromOpExp
                                   )
import FFICXX.Generate.Type.Config ( ModuleUnit(..)
                                   , ModuleUnitImports(..)
                                   , emptyModuleUnitImports
                                   , ModuleUnitMap(..)
                                   )
import FFICXX.Generate.Type.Module ( ClassImportHeader(..)
                                   , ClassModule(..)
                                   , PackageConfig(..)
                                   , TemplateClassImportHeader(..)
                                   , TemplateClassModule(..)
                                   , TopLevelImportHeader(..)
                                   )


-- utility functions

getcabal = either tclass_cabal class_cabal

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

-- TODO: replace tclass_name with appropriate FFI name when supported.
getFFIName = either tclass_name ffiClassName


getPkgName :: Either TemplateClass Class -> CabalName
getPkgName = cabal_pkgname . getcabal


-- |
extractClassFromType :: Types -> [Either TemplateClass Class]
extractClassFromType Void                     = []
extractClassFromType SelfType                 = []
extractClassFromType (CT _ _)                 = []
extractClassFromType (CPT (CPTClass c) _)     = [Right c]
extractClassFromType (CPT (CPTClassRef c) _)  = [Right c]
extractClassFromType (CPT (CPTClassCopy c) _) = [Right c]
extractClassFromType (CPT (CPTClassMove c) _) = [Right c]
extractClassFromType (TemplateApp (TemplateAppInfo t ps _)) =
  Left t : (map Right $ mapMaybe (\case TArg_Class c -> Just c; _ -> Nothing) ps)
extractClassFromType (TemplateAppRef (TemplateAppInfo t ps _))   =
  Left t : (map Right $ mapMaybe (\case TArg_Class c -> Just c; _ -> Nothing) ps)
extractClassFromType (TemplateAppMove (TemplateAppInfo t ps _))   =
  Left t : (map Right $ mapMaybe (\case TArg_Class c -> Just c; _ -> Nothing) ps)
extractClassFromType (TemplateType t)         = [Left t]
extractClassFromType (TemplateParam _)        = []
extractClassFromType (TemplateParamPointer _) = []

classFromArg :: Arg -> [Either TemplateClass Class]
classFromArg = extractClassFromType . arg_type


class_allparents :: Class -> [Class]
class_allparents c = let ps = class_parents c
                     in  if null ps
                           then []
                           else nub (ps <> (concatMap class_allparents ps))


getClassModuleBase :: Class -> String
getClassModuleBase = (<.>) <$> (cabal_moduleprefix.class_cabal) <*> (fst.hsClassName)

getTClassModuleBase :: TemplateClass -> String
getTClassModuleBase = (<.>) <$> (cabal_moduleprefix.tclass_cabal) <*> (fst.hsTemplateClassName)


-- | Daughter map not including itself
mkDaughterMap :: [Class] -> DaughterMap
mkDaughterMap = foldl mkDaughterMapWorker M.empty
  where mkDaughterMapWorker m c = let ps = map getClassModuleBase (class_allparents c)
                                  in  foldl (addmeToYourDaughterList c) m ps
        addmeToYourDaughterList c m p = let f Nothing = Just [c]
                                            f (Just cs)  = Just (c:cs)
                                        in  M.alter f p m



-- | Daughter Map including itself as a daughter
mkDaughterSelfMap :: [Class] -> DaughterMap
mkDaughterSelfMap = foldl' worker M.empty
  where worker m c = let ps = map getClassModuleBase (c:class_allparents c)
                     in  foldl (addToList c) m ps
        addToList c m p = let f Nothing = Just [c]
                              f (Just cs)  = Just (c:cs)
                          in  M.alter f p m



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


-- |
extractClassDep :: Function -> Dep4Func
extractClassDep (Constructor args _)  =
    Dep4Func [] (concatMap classFromArg args)
extractClassDep (Virtual ret _ args _) =
    Dep4Func (extractClassFromType ret) (concatMap classFromArg args)
extractClassDep (NonVirtual ret _ args _) =
    Dep4Func (extractClassFromType ret) (concatMap classFromArg args)
extractClassDep (Static ret _ args _) =
    Dep4Func (extractClassFromType ret) (concatMap classFromArg args)
extractClassDep (Destructor _) =
    Dep4Func [] []

-- |
extractClassDepForTmplFun :: TemplateFunction -> Dep4Func
extractClassDepForTmplFun (TFun ret  _ _ args) =
    Dep4Func (extractClassFromType ret) (concatMap classFromArg args)
extractClassDepForTmplFun (TFunNew args _) =
    Dep4Func [] (concatMap classFromArg args)
extractClassDepForTmplFun TFunDelete =
    Dep4Func [] []
extractClassDepForTmplFun (TFunOp ret  _ e) =
    Dep4Func (extractClassFromType ret) (concatMap classFromArg $ argsFromOpExp e)

-- |
extractClassDep4TmplMemberFun :: TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun (TemplateMemberFunction {..}) =
  Dep4Func (extractClassFromType tmf_ret) (concatMap classFromArg tmf_args)

-- |
extractClassDepForTopLevel :: TopLevel -> Dep4Func
extractClassDepForTopLevel f =
    Dep4Func (extractClassFromType ret) (concatMap (extractClassFromType . arg_type) args)
  where ret = case f of
                TopLevelFunction {..} -> toplevelfunc_ret
                TopLevelVariable {..} -> toplevelvar_ret
        args = case f of
                 TopLevelFunction {..} -> toplevelfunc_args
                 TopLevelVariable {..} -> []


-- TODO: Confirm the answer below is correct.
-- NOTE: Q: Why returnDependency only?
--       A: Difference between argument and return:
--          for a member function f,
--          we have (f :: (IA a, IB b) => a -> b -> IO C
--          return class is concrete and argument class is constraint.
mkModuleDepRaw :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepRaw x@(Right c) =
  nub $
    filter (/= x) $
         concatMap (returnDependency . extractClassDep) (class_funcs c)
      ++ concatMap (returnDependency . extractClassDep4TmplMemberFun) (class_tmpl_funcs c)
mkModuleDepRaw x@(Left t) =
  (nub . filter (/= x) . concatMap (returnDependency.extractClassDepForTmplFun) . tclass_funcs) t

-- |
isNotInSamePackageWith
  :: Either TemplateClass Class
  -> Either TemplateClass Class
  -> Bool
isNotInSamePackageWith x y = (x /= y) && (getPkgName x /= getPkgName y)

-- x is in the sam
isInSamePackageButNotInheritedBy
  :: Either TemplateClass Class -- ^ y
  -> Either TemplateClass Class -- ^ x
  -> Bool
isInSamePackageButNotInheritedBy x y =
  x /= y && not (x `elem` getparents y) && (getPkgName x == getPkgName y)

-- TODO: Confirm the following answer
-- NOTE: Q: why returnDependency is not considered?
--       A: See explanation in mkModuleDepRaw
mkModuleDepHighNonSource :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepHighNonSource y@(Right c) =
  let extclasses = filter (`isNotInSamePackageWith` y) $
                        concatMap (argumentDependency.extractClassDep) (class_funcs c)
                     ++ concatMap (argumentDependency.extractClassDep4TmplMemberFun) (class_tmpl_funcs c)
      parents = map Right (class_parents c)
  in  nub (parents <> extclasses)
mkModuleDepHighNonSource y@(Left t) =
  let fs = tclass_funcs t
      extclasses = filter (`isNotInSamePackageWith` y) $
                     concatMap (argumentDependency.extractClassDepForTmplFun) fs
  in  nub extclasses

-- TODO: Confirm the following answer
-- NOTE: Q: why returnDependency is not considered?
--       A: See explanation in mkModuleDepRaw
mkModuleDepHighSource :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepHighSource y@(Right c) =
  nub $
    filter (`isInSamePackageButNotInheritedBy` y) $
         concatMap (argumentDependency . extractClassDep) (class_funcs c)
      ++ concatMap (argumentDependency . extractClassDep4TmplMemberFun) (class_tmpl_funcs c)
mkModuleDepHighSource y@(Left t) =
  let fs = tclass_funcs t
  in nub $
       filter (`isInSamePackageButNotInheritedBy` y) $
         concatMap (argumentDependency . extractClassDepForTmplFun) fs

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

-- |
mkModuleDepFFI1 :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepFFI1 (Right c) = let fs = class_funcs c
                                vs = class_vars c
                                tmfs = class_tmpl_funcs c
                            in    concatMap (returnDependency.extractClassDep) fs
                               <> concatMap (argumentDependency.extractClassDep) fs
                               <> concatMap (classFromArg . unVariable) vs
                               <> concatMap (returnDependency.extractClassDep4TmplMemberFun) tmfs
                               <> concatMap (argumentDependency.extractClassDep4TmplMemberFun) tmfs
mkModuleDepFFI1 (Left t)  = let fs = tclass_funcs t
                            in    concatMap (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 mkModuleDepFFI1 ps) <> mkModuleDepFFI1 y
  in nub (filter (/= y) alldeps')
mkModuleDepFFI (Left _) = []

-- |
mkClassModule :: (ModuleUnit -> ModuleUnitImports)
              -> [(String,[String])]
              -> Class
              -> ClassModule
mkClassModule getImports extra c =
    ClassModule {
      cmModule = getClassModuleBase c
    , cmCIH = mkCIH getImports c
    , cmImportedModulesHighNonSource = highs_nonsource
    , cmImportedModulesRaw =raws
    , cmImportedModulesHighSource = highs_source
    , cmImportedModulesForFFI = ffis
    , cmExtraImport = extraimports
    }
  where highs_nonsource = mkModuleDepHighNonSource (Right c)
        raws            = mkModuleDepRaw (Right c)
        highs_source    = mkModuleDepHighSource (Right c)
        ffis            = mkModuleDepFFI (Right c)
        extraimports = fromMaybe [] (lookup (class_name c) extra)

-- |
findModuleUnitImports :: ModuleUnitMap -> ModuleUnit -> ModuleUnitImports
findModuleUnitImports m u =
  fromMaybe emptyModuleUnitImports (HM.lookup u (unModuleUnitMap m))

-- |
mkTCM ::
     TemplateClassImportHeader
  -> TemplateClassModule
mkTCM tcih =
  let t = tcihTClass tcih
  in TCM (getTClassModuleBase t) tcih

-- |
mkPackageConfig
  :: (CabalName, ModuleUnit -> ModuleUnitImports) -- ^ (package name,getImports)
  -> ([Class],[TopLevel],[TemplateClassImportHeader],[(String,[String])])
  -> [AddCInc]
  -> [AddCSrc]
  -> PackageConfig
mkPackageConfig (pkgname,getImports) (cs,fs,ts,extra) acincs acsrcs =
  let ms = map (mkClassModule getImports extra) cs
      cmpfunc x y = class_name (cihClass x) == class_name (cihClass y)
      cihs = nubBy cmpfunc (map cmCIH ms)
      --
      tih = mkTIH pkgname getImports cihs fs
      tcms = map mkTCM ts
      tcihs = map tcmTCIH tcms
  in PkgConfig {
       pcfg_classModules = ms
     , pcfg_classImportHeaders = cihs
     , pcfg_topLevelImportHeader = tih
     , pcfg_templateClassModules = tcms
     , pcfg_templateClassImportHeaders = tcihs
     , pcfg_additional_c_incs = acincs
     , pcfg_additional_c_srcs = acsrcs
     }

-- TODO: change [String] to Set String
mkHSBOOTCandidateList :: [ClassModule] -> [String]
mkHSBOOTCandidateList ms =
  let
    -- get only class dependencies, not template classes.
    cs = rights (concatMap cmImportedModulesHighSource ms)
  in
    nub (map getClassModuleBase cs)

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

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

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

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

-- |
mkCIH :: (ModuleUnit -> ModuleUnitImports)  -- ^ (mk namespace and include headers)
      -> Class
      -> ClassImportHeader
mkCIH getImports c =
  ClassImportHeader {
    cihClass                    = c
  , cihSelfHeader               = mkPkgHeaderFileName c
  , cihNamespace                = (muimports_namespaces . getImports . MU_Class . class_name) c
  , cihSelfCpp                  = mkPkgCppFileName c
  , cihImportedClasses          = mkModuleDepCpp (Right c)
  , cihIncludedHPkgHeadersInH   = mkPkgIncludeHeadersInH c
  , cihIncludedHPkgHeadersInCPP = mkPkgIncludeHeadersInCPP c
  , cihIncludedCPkgHeaders      = (muimports_headers . getImports . MU_Class . class_name) c
  }

-- | for top-level
mkTIH
  :: CabalName
  -> (ModuleUnit -> ModuleUnitImports)
  -> [ClassImportHeader]
  -> [TopLevel]
  -> TopLevelImportHeader
mkTIH pkgname getImports cihs fs =
  let tl_cs1 = concatMap (argumentDependency . extractClassDepForTopLevel) fs
      tl_cs2 = concatMap (returnDependency . extractClassDepForTopLevel) fs
      tl_cs = nubBy ((==) `on` either tclass_name ffiClassName) (tl_cs1 <> tl_cs2)
      -- NOTE: Select only class dependencies in the current package.
      -- TODO: This is clearly not a good impl. we need to look into this again
      --       after reconsidering multi-package generation.
      tl_cihs = catMaybes (foldr fn [] tl_cs)
         where
           fn c ys =
             let y = find (\x -> (ffiClassName . cihClass) x == getFFIName c) cihs
             in y:ys
      -- NOTE: The remaining class dependencies outside the current package
      extclasses = filter ((/= pkgname) . getPkgName) tl_cs
      extheaders = map HdrName $
                     nub $
                       map ((<>"Type.h") . unCabalName . getPkgName)  extclasses

  in
     TopLevelImportHeader {
       tihHeaderFileName = unCabalName pkgname <> "TopLevel"
     , tihClassDep = tl_cihs
     , tihExtraClassDep = extclasses
     , tihFuncs = fs
     , tihNamespaces        = muimports_namespaces (getImports MU_TopLevel)
     , tihExtraHeadersInH   = extheaders
     , tihExtraHeadersInCPP = muimports_headers (getImports MU_TopLevel)
     }