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

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.Bifunctor (bimap)
import Data.Either (rights)
import Data.Function (on)
import qualified Data.HashMap.Strict as HM
import qualified Data.List as L (find, foldl', nub, nubBy)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import FFICXX.Generate.Name
  ( ffiClassName,
    getClassModuleBase,
    getTClassModuleBase,
    hsClassName,
  )
import FFICXX.Generate.Type.Cabal
  ( AddCInc,
    AddCSrc,
    CabalName (..),
    cabal_cheaderprefix,
    cabal_pkgname,
    unCabalName,
  )
import FFICXX.Generate.Type.Class
  ( Arg (..),
    CPPTypes (..),
    Class (..),
    DaughterMap,
    Function (..),
    TLOrdinary (..),
    TLTemplate (..),
    TemplateAppInfo (..),
    TemplateArgType (TArg_Class),
    TemplateClass (..),
    TemplateFunction (..),
    TemplateMemberFunction (..),
    TopLevel (..),
    Types (..),
    Variable (unVariable),
    argsFromOpExp,
    filterTLOrdinary,
    virtualFuncs,
  )
import FFICXX.Generate.Type.Config
  ( ModuleUnit (..),
    ModuleUnitImports (..),
    ModuleUnitMap (..),
    emptyModuleUnitImports,
  )
import FFICXX.Generate.Type.Module
  ( ClassImportHeader (..),
    ClassModule (..),
    ClassSubmoduleType (..),
    PackageConfig (..),
    TemplateClassImportHeader (..),
    TemplateClassModule (..),
    TemplateClassSubmoduleType (..),
    TopLevelImportHeader (..),
    UClassSubmodule,
  )
import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..))
import System.FilePath ((<.>))

-- utility functions

getcabal :: Either TemplateClass Class -> Cabal
getcabal = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TemplateClass -> Cabal
tclass_cabal Class -> Cabal
class_cabal

getparents :: Either a Class -> [Either a Class]
getparents = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Class]
class_parents)

-- TODO: replace tclass_name with appropriate FFI name when supported.
getFFIName :: Either TemplateClass Class -> String
getFFIName = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TemplateClass -> String
tclass_name Class -> String
ffiClassName

getPkgName :: Either TemplateClass Class -> CabalName
getPkgName :: Either TemplateClass Class -> CabalName
getPkgName = Cabal -> CabalName
cabal_pkgname forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> Cabal
getcabal

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

classFromArg :: Arg -> [Either TemplateClass Class]
classFromArg :: Arg -> [Either TemplateClass Class]
classFromArg = Types -> [Either TemplateClass Class]
extractClassFromType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type

class_allparents :: Class -> [Class]
class_allparents :: Class -> [Class]
class_allparents Class
c =
  let ps :: [Class]
ps = Class -> [Class]
class_parents Class
c
   in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Class]
ps
        then []
        else forall a. Eq a => [a] -> [a]
L.nub ([Class]
ps forall a. Semigroup a => a -> a -> a
<> (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Class -> [Class]
class_allparents [Class]
ps))

-- | Daughter map not including itself
mkDaughterMap :: [Class] -> DaughterMap
mkDaughterMap :: [Class] -> DaughterMap
mkDaughterMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DaughterMap -> Class -> DaughterMap
mkDaughterMapWorker forall k a. Map k a
M.empty
  where
    mkDaughterMapWorker :: DaughterMap -> Class -> DaughterMap
mkDaughterMapWorker DaughterMap
m Class
c =
      let ps :: [String]
ps = forall a b. (a -> b) -> [a] -> [b]
map Class -> String
getClassModuleBase (Class -> [Class]
class_allparents Class
c)
       in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {k} {p}. Ord k => p -> Map k [p] -> k -> Map k [p]
addmeToYourDaughterList Class
c) DaughterMap
m [String]
ps
    addmeToYourDaughterList :: p -> Map k [p] -> k -> Map k [p]
addmeToYourDaughterList p
c Map k [p]
m k
p =
      let f :: Maybe [p] -> Maybe [p]
f Maybe [p]
Nothing = forall a. a -> Maybe a
Just [p
c]
          f (Just [p]
cs) = forall a. a -> Maybe a
Just (p
c forall a. a -> [a] -> [a]
: [p]
cs)
       in forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [p] -> Maybe [p]
f k
p Map k [p]
m

-- | Daughter Map including itself as a daughter
mkDaughterSelfMap :: [Class] -> DaughterMap
mkDaughterSelfMap :: [Class] -> DaughterMap
mkDaughterSelfMap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' DaughterMap -> Class -> DaughterMap
worker forall k a. Map k a
M.empty
  where
    worker :: DaughterMap -> Class -> DaughterMap
worker DaughterMap
m Class
c =
      let ps :: [String]
ps = forall a b. (a -> b) -> [a] -> [b]
map Class -> String
getClassModuleBase (Class
c forall a. a -> [a] -> [a]
: Class -> [Class]
class_allparents Class
c)
       in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall {k} {p}. Ord k => p -> Map k [p] -> k -> Map k [p]
addToList Class
c) DaughterMap
m [String]
ps
    addToList :: p -> Map k [p] -> k -> Map k [p]
addToList p
c Map k [p]
m k
p =
      let f :: Maybe [p] -> Maybe [p]
f Maybe [p]
Nothing = forall a. a -> Maybe a
Just [p
c]
          f (Just [p]
cs) = forall a. a -> Maybe a
Just (p
c forall a. a -> [a] -> [a]
: [p]
cs)
       in forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe [p] -> Maybe [p]
f k
p Map k [p]
m

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

-- |
extractClassDep :: Function -> Dep4Func
extractClassDep :: Function -> Dep4Func
extractClassDep (Constructor [Arg]
args Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func [] (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDep (Virtual Types
ret String
_ [Arg]
args Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDep (NonVirtual Types
ret String
_ [Arg]
args Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDep (Static Types
ret String
_ [Arg]
args Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDep (Destructor Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func [] []

-- |
extractClassDepForTmplFun :: TemplateFunction -> Dep4Func
extractClassDepForTmplFun :: TemplateFunction -> Dep4Func
extractClassDepForTmplFun (TFun Types
ret String
_ String
_ [Arg]
args) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDepForTmplFun (TFunNew [Arg]
args Maybe String
_) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func [] (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
args)
extractClassDepForTmplFun TemplateFunction
TFunDelete =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func [] []
extractClassDepForTmplFun (TFunOp Types
ret String
_ OpExp
e) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg forall a b. (a -> b) -> a -> b
$ OpExp -> [Arg]
argsFromOpExp OpExp
e)

-- |
extractClassDep4TmplMemberFun :: TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun :: TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun (TemplateMemberFunction {String
[String]
[Arg]
Maybe String
Types
tmf_alias :: TemplateMemberFunction -> Maybe String
tmf_args :: TemplateMemberFunction -> [Arg]
tmf_name :: TemplateMemberFunction -> String
tmf_ret :: TemplateMemberFunction -> Types
tmf_params :: TemplateMemberFunction -> [String]
tmf_alias :: Maybe String
tmf_args :: [Arg]
tmf_name :: String
tmf_ret :: Types
tmf_params :: [String]
..}) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
tmf_ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg [Arg]
tmf_args)

-- |
extractClassDepForTLOrdinary :: TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary :: TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary TLOrdinary
f =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Types -> [Either TemplateClass Class]
extractClassFromType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
args)
  where
    ret :: Types
ret = case TLOrdinary
f of
      TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
..} -> Types
toplevelfunc_ret
      TopLevelVariable {String
Maybe String
Types
toplevelvar_alias :: TLOrdinary -> Maybe String
toplevelvar_name :: TLOrdinary -> String
toplevelvar_ret :: TLOrdinary -> Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
..} -> Types
toplevelvar_ret
    args :: [Arg]
args = case TLOrdinary
f of
      TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_ret :: TLOrdinary -> Types
..} -> [Arg]
toplevelfunc_args
      TopLevelVariable {} -> []

-- |
extractClassDepForTLTemplate :: TLTemplate -> Dep4Func
extractClassDepForTLTemplate :: TLTemplate -> Dep4Func
extractClassDepForTLTemplate TLTemplate
f =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
ret) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Types -> [Either TemplateClass Class]
extractClassFromType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
args)
  where
    ret :: Types
ret = TLTemplate -> Types
topleveltfunc_ret TLTemplate
f
    args :: [Arg]
args = TLTemplate -> [Arg]
topleveltfunc_args TLTemplate
f

mkDepFFI :: Class -> [UClassSubmodule]
mkDepFFI :: Class -> [UClassSubmodule]
mkDepFFI Class
cls =
  let ps :: [Either a Class]
ps = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (Class -> [Class]
class_allparents Class
cls)
      alldeps' :: [Either TemplateClass Class]
alldeps' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either TemplateClass Class -> [Either TemplateClass Class]
go forall {a}. [Either a Class]
ps forall a. Semigroup a => a -> a -> a
<> Either TemplateClass Class -> [Either TemplateClass Class]
go (forall a b. b -> Either a b
Right Class
cls)
      depSelf :: Either a (ClassSubmoduleType, Class)
depSelf = forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls)
   in forall {a}. Either a (ClassSubmoduleType, Class)
depSelf forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTRawType,)) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= forall a b. b -> Either a b
Right Class
cls) [Either TemplateClass Class]
alldeps')
  where
    go :: Either TemplateClass Class -> [Either TemplateClass Class]
go (Right Class
c) =
      let fs :: [Function]
fs = Class -> [Function]
class_funcs Class
c
          vs :: [Variable]
vs = Class -> [Variable]
class_vars Class
c
          tmfs :: [TemplateMemberFunction]
tmfs = Class -> [TemplateMemberFunction]
class_tmpl_funcs Class
c
       in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Arg -> [Either TemplateClass Class]
classFromArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Arg
unVariable) [Variable]
vs
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
    go (Left TemplateClass
t) =
      let fs :: [TemplateFunction]
fs = TemplateClass -> [TemplateFunction]
tclass_funcs TemplateClass
t
       in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs

-- For raws:
-- NOTE: Q: Why returnDependency for RawTypes?
--       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.
calculateDependency :: UClassSubmodule -> [UClassSubmodule]
calculateDependency :: UClassSubmodule -> [UClassSubmodule]
calculateDependency (Left (TemplateClassSubmoduleType
typ, TemplateClass
tcl)) = [UClassSubmodule]
raws forall a. Semigroup a => a -> a -> a
<> [UClassSubmodule]
inplaces
  where
    raws' :: [Either TemplateClass Class]
raws' =
      forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= forall a b. a -> Either a b
Left TemplateClass
tcl) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) forall a b. (a -> b) -> a -> b
$
            TemplateClass -> [TemplateFunction]
tclass_funcs TemplateClass
tcl
    raws :: [UClassSubmodule]
raws =
      case TemplateClassSubmoduleType
typ of
        TemplateClassSubmoduleType
TCSTTemplate ->
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTRawType,)) [Either TemplateClass Class]
raws'
        TemplateClassSubmoduleType
TCSTTH ->
          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            ( \case
                Left TemplateClass
t -> [forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, TemplateClass
t)]
                Right Class
c -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Class
c)) [ClassSubmoduleType
CSTRawType, ClassSubmoduleType
CSTCast, ClassSubmoduleType
CSTInterface]
            )
            [Either TemplateClass Class]
raws'
    inplaces :: [UClassSubmodule]
inplaces =
      let fs :: [TemplateFunction]
fs = TemplateClass -> [TemplateFunction]
tclass_funcs TemplateClass
tcl
       in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) forall a b. (a -> b) -> a -> b
$
            forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$
              forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isInSamePackageButNotInheritedBy` forall a b. a -> Either a b
Left TemplateClass
tcl) forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
calculateDependency (Right (ClassSubmoduleType
CSTRawType, Class
_)) = []
calculateDependency (Right (ClassSubmoduleType
CSTFFI, Class
cls)) = Class -> [UClassSubmodule]
mkDepFFI Class
cls
calculateDependency (Right (ClassSubmoduleType
CSTInterface, Class
cls)) =
  let retDepClasses :: [Either TemplateClass Class]
retDepClasses =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) ([Function] -> [Function]
virtualFuncs forall a b. (a -> b) -> a -> b
$ Class -> [Function]
class_funcs Class
cls)
          forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) (Class -> [TemplateMemberFunction]
class_tmpl_funcs Class
cls)
      argDepClasses :: [Either TemplateClass Class]
argDepClasses =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) ([Function] -> [Function]
virtualFuncs forall a b. (a -> b) -> a -> b
$ Class -> [Function]
class_funcs Class
cls)
          forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) (Class -> [TemplateMemberFunction]
class_tmpl_funcs Class
cls)
      rawSelf :: Either a (ClassSubmoduleType, Class)
rawSelf = forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls)
      raws :: [UClassSubmodule]
raws =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTRawType,)) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= forall a b. b -> Either a b
Right Class
cls) [Either TemplateClass Class]
retDepClasses
      exts :: [UClassSubmodule]
exts =
        let extclasses :: [Either TemplateClass Class]
extclasses =
              forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isNotInSamePackageWith` forall a b. b -> Either a b
Right Class
cls) [Either TemplateClass Class]
argDepClasses
            parents :: [Either a Class]
parents = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right (Class -> [Class]
class_parents Class
cls)
         in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
L.nub (forall {a}. [Either a Class]
parents forall a. Semigroup a => a -> a -> a
<> [Either TemplateClass Class]
extclasses)
      inplaces :: [UClassSubmodule]
inplaces =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) forall a b. (a -> b) -> a -> b
$
          forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isInSamePackageButNotInheritedBy` forall a b. b -> Either a b
Right Class
cls) forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class]
argDepClasses
   in forall {a}. Either a (ClassSubmoduleType, Class)
rawSelf forall a. a -> [a] -> [a]
: ([UClassSubmodule]
raws forall a. [a] -> [a] -> [a]
++ [UClassSubmodule]
exts forall a. [a] -> [a] -> [a]
++ [UClassSubmodule]
inplaces)
calculateDependency (Right (ClassSubmoduleType
CSTCast, Class
cls)) = [forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls), forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
cls)]
calculateDependency (Right (ClassSubmoduleType
CSTImplementation, Class
cls)) =
  let depsSelf :: [Either a (ClassSubmoduleType, Class)]
depsSelf =
        [ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls),
          forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTFFI, Class
cls),
          forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
cls),
          forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
cls)
        ]
      dsFFI :: [Either TemplateClass Class]
dsFFI = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (a, b) -> b
snd forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ Class -> [UClassSubmodule]
mkDepFFI Class
cls
      dsParents :: [Either TemplateClass Class]
dsParents = forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Class -> [Class]
class_allparents Class
cls
      dsNonParents :: [Either TemplateClass Class]
dsNonParents = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Either TemplateClass Class]
dsParents)) [Either TemplateClass Class]
dsFFI

      deps :: [UClassSubmodule]
deps =
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \case
              Left TemplateClass
t -> [forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, TemplateClass
t)]
              Right Class
c ->
                [ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
c),
                  forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
c),
                  forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
c)
                ]
          )
          ([Either TemplateClass Class]
dsNonParents forall a. Semigroup a => a -> a -> a
<> [Either TemplateClass Class]
dsParents)
   in forall {a}. [Either a (ClassSubmoduleType, Class)]
depsSelf forall a. Semigroup a => a -> a -> a
<> [UClassSubmodule]
deps

-- |
isNotInSamePackageWith ::
  Either TemplateClass Class ->
  Either TemplateClass Class ->
  Bool
isNotInSamePackageWith :: Either TemplateClass Class -> Either TemplateClass Class -> Bool
isNotInSamePackageWith Either TemplateClass Class
x Either TemplateClass Class
y = (Either TemplateClass Class
x forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) Bool -> Bool -> Bool
&& (Either TemplateClass Class -> CabalName
getPkgName Either TemplateClass Class
x forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class -> CabalName
getPkgName Either TemplateClass Class
y)

-- x is in the sam
isInSamePackageButNotInheritedBy ::
  -- | y
  Either TemplateClass Class ->
  -- | x
  Either TemplateClass Class ->
  Bool
isInSamePackageButNotInheritedBy :: Either TemplateClass Class -> Either TemplateClass Class -> Bool
isInSamePackageButNotInheritedBy Either TemplateClass Class
x Either TemplateClass Class
y =
  Either TemplateClass Class
x forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Either TemplateClass Class
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall {a} {a}. Either a Class -> [Either a Class]
getparents Either TemplateClass Class
y) Bool -> Bool -> Bool
&& (Either TemplateClass Class -> CabalName
getPkgName Either TemplateClass Class
x forall a. Eq a => a -> a -> Bool
== Either TemplateClass Class -> CabalName
getPkgName Either TemplateClass Class
y)

-- |
mkModuleDepCpp :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp :: Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp y :: Either TemplateClass Class
y@(Right Class
c) =
  let fs :: [Function]
fs = Class -> [Function]
class_funcs Class
c
      vs :: [Variable]
vs = Class -> [Variable]
class_vars Class
c
      tmfs :: [TemplateMemberFunction]
tmfs = Class -> [TemplateMemberFunction]
class_tmpl_funcs Class
c
   in forall a. Eq a => [a] -> [a]
L.nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Arg -> [Either TemplateClass Class]
classFromArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Arg
unVariable) [Variable]
vs
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
          forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. Either a Class -> [Either a Class]
getparents Either TemplateClass Class
y
mkModuleDepCpp y :: Either TemplateClass Class
y@(Left TemplateClass
t) =
  let fs :: [TemplateFunction]
fs = TemplateClass -> [TemplateFunction]
tclass_funcs TemplateClass
t
   in forall a. Eq a => [a] -> [a]
L.nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
          forall a. Semigroup a => a -> a -> a
<> forall {a} {a}. Either a Class -> [Either a Class]
getparents Either TemplateClass Class
y

-- | Find module-level dependency per each toplevel function/template function.
mkTopLevelDep :: TopLevel -> [UClassSubmodule]
mkTopLevelDep :: TopLevel -> [UClassSubmodule]
mkTopLevelDep (TLOrdinary TLOrdinary
f) =
  let dep4func :: Dep4Func
dep4func = TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary TLOrdinary
f
      allDeps :: [Either TemplateClass Class]
allDeps = Dep4Func -> [Either TemplateClass Class]
returnDependency Dep4Func
dep4func forall a. [a] -> [a] -> [a]
++ Dep4Func -> [Either TemplateClass Class]
argumentDependency Dep4Func
dep4func
      mkTags :: Either b t
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
mkTags (Left b
tcl) = [forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, b
tcl)]
      mkTags (Right t
cls) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,t
cls)) [ClassSubmoduleType
CSTRawType, ClassSubmoduleType
CSTCast, ClassSubmoduleType
CSTInterface]
   in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {t}.
Either b t
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
mkTags [Either TemplateClass Class]
allDeps
mkTopLevelDep (TLTemplate TLTemplate
f) =
  let dep4func :: Dep4Func
dep4func = TLTemplate -> Dep4Func
extractClassDepForTLTemplate TLTemplate
f
      allDeps :: [Either TemplateClass Class]
allDeps = Dep4Func -> [Either TemplateClass Class]
returnDependency Dep4Func
dep4func forall a. [a] -> [a] -> [a]
++ Dep4Func -> [Either TemplateClass Class]
argumentDependency Dep4Func
dep4func
      mkTags :: Either b t
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
mkTags (Left b
tcl) = [forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, b
tcl)]
      mkTags (Right t
cls) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,t
cls)) [ClassSubmoduleType
CSTRawType, ClassSubmoduleType
CSTCast, ClassSubmoduleType
CSTInterface]
   in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b} {t}.
Either b t
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
mkTags [Either TemplateClass Class]
allDeps

-- |
mkClassModule ::
  (ModuleUnit -> ModuleUnitImports) ->
  [(String, [String])] ->
  Class ->
  ClassModule
mkClassModule :: (ModuleUnit -> ModuleUnitImports)
-> [(String, [String])] -> Class -> ClassModule
mkClassModule ModuleUnit -> ModuleUnitImports
getImports [(String, [String])]
extra Class
c =
  ClassModule
    { cmModule :: String
cmModule = Class -> String
getClassModuleBase Class
c,
      cmCIH :: ClassImportHeader
cmCIH = (ModuleUnit -> ModuleUnitImports) -> Class -> ClassImportHeader
mkCIH ModuleUnit -> ModuleUnitImports
getImports Class
c,
      cmImportedSubmodulesForInterface :: [UClassSubmodule]
cmImportedSubmodulesForInterface = UClassSubmodule -> [UClassSubmodule]
calculateDependency forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
c),
      cmImportedSubmodulesForFFI :: [UClassSubmodule]
cmImportedSubmodulesForFFI = UClassSubmodule -> [UClassSubmodule]
calculateDependency forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTFFI, Class
c),
      cmImportedSubmodulesForCast :: [UClassSubmodule]
cmImportedSubmodulesForCast = UClassSubmodule -> [UClassSubmodule]
calculateDependency forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
c),
      cmImportedSubmodulesForImplementation :: [UClassSubmodule]
cmImportedSubmodulesForImplementation = UClassSubmodule -> [UClassSubmodule]
calculateDependency forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTImplementation, Class
c),
      cmExtraImport :: [String]
cmExtraImport = forall a. a -> Maybe a -> a
fromMaybe [] (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Class -> String
class_name Class
c) [(String, [String])]
extra)
    }

-- |
findModuleUnitImports :: ModuleUnitMap -> ModuleUnit -> ModuleUnitImports
findModuleUnitImports :: ModuleUnitMap -> ModuleUnit -> ModuleUnitImports
findModuleUnitImports ModuleUnitMap
m ModuleUnit
u =
  forall a. a -> Maybe a -> a
fromMaybe ModuleUnitImports
emptyModuleUnitImports (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ModuleUnit
u (ModuleUnitMap -> HashMap ModuleUnit ModuleUnitImports
unModuleUnitMap ModuleUnitMap
m))

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

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

-- |
mkPkgHeaderFileName :: Class -> HeaderName
mkPkgHeaderFileName :: Class -> HeaderName
mkPkgHeaderFileName Class
c =
  String -> HeaderName
HdrName
    ( (Cabal -> String
cabal_cheaderprefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
        forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)
        String -> String -> String
<.> String
"h"
    )

-- |
mkPkgCppFileName :: Class -> String
mkPkgCppFileName :: Class -> String
mkPkgCppFileName Class
c =
  (Cabal -> String
cabal_cheaderprefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
    forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)
    String -> String -> String
<.> String
"cpp"

-- |
mkPkgIncludeHeadersInH :: Class -> [HeaderName]
mkPkgIncludeHeadersInH :: Class -> [HeaderName]
mkPkgIncludeHeadersInH Class
c =
  let pkgname :: CabalName
pkgname = (Cabal -> CabalName
cabal_pkgname forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
      extclasses :: [Either TemplateClass Class]
extclasses = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= CabalName
pkgname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Class
c
      extheaders :: [String]
extheaders = forall a. Eq a => [a] -> [a]
L.nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> String
"Type.h") forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalName -> String
unCabalName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class]
extclasses
   in forall a b. (a -> b) -> [a] -> [b]
map Class -> HeaderName
mkPkgHeaderFileName (Class -> [Class]
class_allparents Class
c) forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map String -> HeaderName
HdrName [String]
extheaders

-- |
mkPkgIncludeHeadersInCPP :: Class -> [HeaderName]
mkPkgIncludeHeadersInCPP :: Class -> [HeaderName]
mkPkgIncludeHeadersInCPP = forall a b. (a -> b) -> [a] -> [b]
map Class -> HeaderName
mkPkgHeaderFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

-- |
mkCIH ::
  -- | (mk namespace and include headers)
  (ModuleUnit -> ModuleUnitImports) ->
  Class ->
  ClassImportHeader
mkCIH :: (ModuleUnit -> ModuleUnitImports) -> Class -> ClassImportHeader
mkCIH ModuleUnit -> ModuleUnitImports
getImports Class
c =
  ClassImportHeader
    { cihClass :: Class
cihClass = Class
c,
      cihSelfHeader :: HeaderName
cihSelfHeader = Class -> HeaderName
mkPkgHeaderFileName Class
c,
      cihNamespace :: [Namespace]
cihNamespace = (ModuleUnitImports -> [Namespace]
muimports_namespaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleUnit -> ModuleUnitImports
getImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleUnit
MU_Class forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> String
class_name) Class
c,
      cihSelfCpp :: String
cihSelfCpp = Class -> String
mkPkgCppFileName Class
c,
      cihImportedClasses :: [Either TemplateClass Class]
cihImportedClasses = Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp (forall a b. b -> Either a b
Right Class
c),
      cihIncludedHPkgHeadersInH :: [HeaderName]
cihIncludedHPkgHeadersInH = Class -> [HeaderName]
mkPkgIncludeHeadersInH Class
c,
      cihIncludedHPkgHeadersInCPP :: [HeaderName]
cihIncludedHPkgHeadersInCPP = Class -> [HeaderName]
mkPkgIncludeHeadersInCPP Class
c,
      cihIncludedCPkgHeaders :: [HeaderName]
cihIncludedCPkgHeaders = (ModuleUnitImports -> [HeaderName]
muimports_headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleUnit -> ModuleUnitImports
getImports forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleUnit
MU_Class forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> String
class_name) Class
c
    }

-- | for top-level
mkTIH ::
  CabalName ->
  (ModuleUnit -> ModuleUnitImports) ->
  [ClassImportHeader] ->
  [TopLevel] ->
  TopLevelImportHeader
mkTIH :: CabalName
-> (ModuleUnit -> ModuleUnitImports)
-> [ClassImportHeader]
-> [TopLevel]
-> TopLevelImportHeader
mkTIH CabalName
pkgname ModuleUnit -> ModuleUnitImports
getImports [ClassImportHeader]
cihs [TopLevel]
fs =
  let ofs :: [TLOrdinary]
ofs = [TopLevel] -> [TLOrdinary]
filterTLOrdinary [TopLevel]
fs
      tl_cs1 :: [Either TemplateClass Class]
tl_cs1 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary) [TLOrdinary]
ofs
      tl_cs2 :: [Either TemplateClass Class]
tl_cs2 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary) [TLOrdinary]
ofs
      tl_cs :: [Either TemplateClass Class]
tl_cs = forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TemplateClass -> String
tclass_name Class -> String
ffiClassName) ([Either TemplateClass Class]
tl_cs1 forall a. Semigroup a => a -> a -> a
<> [Either TemplateClass Class]
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 :: [ClassImportHeader]
tl_cihs = forall a. [Maybe a] -> [a]
catMaybes (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Either TemplateClass Class
-> [Maybe ClassImportHeader] -> [Maybe ClassImportHeader]
fn [] [Either TemplateClass Class]
tl_cs)
        where
          fn :: Either TemplateClass Class
-> [Maybe ClassImportHeader] -> [Maybe ClassImportHeader]
fn Either TemplateClass Class
c [Maybe ClassImportHeader]
ys =
            let y :: Maybe ClassImportHeader
y = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\ClassImportHeader
x -> (Class -> String
ffiClassName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassImportHeader -> Class
cihClass) ClassImportHeader
x forall a. Eq a => a -> a -> Bool
== Either TemplateClass Class -> String
getFFIName Either TemplateClass Class
c) [ClassImportHeader]
cihs
             in Maybe ClassImportHeader
y forall a. a -> [a] -> [a]
: [Maybe ClassImportHeader]
ys
      -- NOTE: The remaining class dependencies outside the current package
      extclasses :: [Either TemplateClass Class]
extclasses = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= CabalName
pkgname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) [Either TemplateClass Class]
tl_cs
      extheaders :: [HeaderName]
extheaders =
        forall a b. (a -> b) -> [a] -> [b]
map String -> HeaderName
HdrName forall a b. (a -> b) -> a -> b
$
          forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> String
"Type.h") forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalName -> String
unCabalName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) [Either TemplateClass Class]
extclasses
   in TopLevelImportHeader
        { tihHeaderFileName :: String
tihHeaderFileName = CabalName -> String
unCabalName CabalName
pkgname forall a. Semigroup a => a -> a -> a
<> String
"TopLevel",
          tihClassDep :: [ClassImportHeader]
tihClassDep = [ClassImportHeader]
tl_cihs,
          tihExtraClassDep :: [Either TemplateClass Class]
tihExtraClassDep = [Either TemplateClass Class]
extclasses,
          tihFuncs :: [TopLevel]
tihFuncs = [TopLevel]
fs,
          tihNamespaces :: [Namespace]
tihNamespaces = ModuleUnitImports -> [Namespace]
muimports_namespaces (ModuleUnit -> ModuleUnitImports
getImports ModuleUnit
MU_TopLevel),
          tihExtraHeadersInH :: [HeaderName]
tihExtraHeadersInH = [HeaderName]
extheaders,
          tihExtraHeadersInCPP :: [HeaderName]
tihExtraHeadersInCPP = ModuleUnitImports -> [HeaderName]
muimports_headers (ModuleUnit -> ModuleUnitImports
getImports ModuleUnit
MU_TopLevel)
        }