{-# 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 = (TemplateClass -> Cabal)
-> (Class -> Cabal) -> Either TemplateClass Class -> Cabal
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 = (a -> [Either a Class])
-> (Class -> [Either a Class])
-> Either a Class
-> [Either a Class]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Either a Class] -> a -> [Either a Class]
forall a b. a -> b -> a
const []) ((Class -> Either a Class) -> [Class] -> [Either a Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either a Class
forall a b. b -> Either a b
Right ([Class] -> [Either a Class])
-> (Class -> [Class]) -> Class -> [Either a Class]
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 = (TemplateClass -> String)
-> (Class -> String) -> Either TemplateClass Class -> String
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 (Cabal -> CabalName)
-> (Either TemplateClass Class -> Cabal)
-> Either TemplateClass Class
-> CabalName
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
_) = [Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
c]
extractClassFromType (CPT (CPTClassRef Class
c) IsConst
_) = [Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
c]
extractClassFromType (CPT (CPTClassCopy Class
c) IsConst
_) = [Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
c]
extractClassFromType (CPT (CPTClassMove Class
c) IsConst
_) = [Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
c]
extractClassFromType (TemplateApp (TemplateAppInfo TemplateClass
t [TemplateArgType]
ps String
_)) =
  TemplateClass -> Either TemplateClass Class
forall a b. a -> Either a b
Left TemplateClass
t Either TemplateClass Class
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. a -> [a] -> [a]
: ((Class -> Either TemplateClass Class)
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right ([Class] -> [Either TemplateClass Class])
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (TemplateArgType -> Maybe Class) -> [TemplateArgType] -> [Class]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case TArg_Class Class
c -> Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c; TemplateArgType
_ -> Maybe Class
forall a. Maybe a
Nothing) [TemplateArgType]
ps)
extractClassFromType (TemplateAppRef (TemplateAppInfo TemplateClass
t [TemplateArgType]
ps String
_)) =
  TemplateClass -> Either TemplateClass Class
forall a b. a -> Either a b
Left TemplateClass
t Either TemplateClass Class
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. a -> [a] -> [a]
: ((Class -> Either TemplateClass Class)
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right ([Class] -> [Either TemplateClass Class])
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (TemplateArgType -> Maybe Class) -> [TemplateArgType] -> [Class]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case TArg_Class Class
c -> Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c; TemplateArgType
_ -> Maybe Class
forall a. Maybe a
Nothing) [TemplateArgType]
ps)
extractClassFromType (TemplateAppMove (TemplateAppInfo TemplateClass
t [TemplateArgType]
ps String
_)) =
  TemplateClass -> Either TemplateClass Class
forall a b. a -> Either a b
Left TemplateClass
t Either TemplateClass Class
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. a -> [a] -> [a]
: ((Class -> Either TemplateClass Class)
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right ([Class] -> [Either TemplateClass Class])
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (TemplateArgType -> Maybe Class) -> [TemplateArgType] -> [Class]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case TArg_Class Class
c -> Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c; TemplateArgType
_ -> Maybe Class
forall a. Maybe a
Nothing) [TemplateArgType]
ps)
extractClassFromType (TemplateType TemplateClass
t) = [TemplateClass -> Either TemplateClass Class
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 (Types -> [Either TemplateClass Class])
-> (Arg -> Types) -> Arg -> [Either TemplateClass Class]
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 [Class] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Class]
ps
        then []
        else [Class] -> [Class]
forall a. Eq a => [a] -> [a]
L.nub ([Class]
ps [Class] -> [Class] -> [Class]
forall a. Semigroup a => a -> a -> a
<> ((Class -> [Class]) -> [Class] -> [Class]
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 = (DaughterMap -> Class -> DaughterMap)
-> DaughterMap -> [Class] -> DaughterMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DaughterMap -> Class -> DaughterMap
mkDaughterMapWorker DaughterMap
forall k a. Map k a
M.empty
  where
    mkDaughterMapWorker :: DaughterMap -> Class -> DaughterMap
mkDaughterMapWorker DaughterMap
m Class
c =
      let ps :: [String]
ps = (Class -> String) -> [Class] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Class -> String
getClassModuleBase (Class -> [Class]
class_allparents Class
c)
       in (DaughterMap -> String -> DaughterMap)
-> DaughterMap -> [String] -> DaughterMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Class -> DaughterMap -> String -> DaughterMap
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 = [p] -> Maybe [p]
forall a. a -> Maybe a
Just [p
c]
          f (Just [p]
cs) = [p] -> Maybe [p]
forall a. a -> Maybe a
Just (p
c p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
cs)
       in (Maybe [p] -> Maybe [p]) -> k -> Map k [p] -> Map k [p]
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 = (DaughterMap -> Class -> DaughterMap)
-> DaughterMap -> [Class] -> DaughterMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' DaughterMap -> Class -> DaughterMap
worker DaughterMap
forall k a. Map k a
M.empty
  where
    worker :: DaughterMap -> Class -> DaughterMap
worker DaughterMap
m Class
c =
      let ps :: [String]
ps = (Class -> String) -> [Class] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Class -> String
getClassModuleBase (Class
c Class -> [Class] -> [Class]
forall a. a -> [a] -> [a]
: Class -> [Class]
class_allparents Class
c)
       in (DaughterMap -> String -> DaughterMap)
-> DaughterMap -> [String] -> DaughterMap
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Class -> DaughterMap -> String -> DaughterMap
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 = [p] -> Maybe [p]
forall a. a -> Maybe a
Just [p
c]
          f (Just [p]
cs) = [p] -> Maybe [p]
forall a. a -> Maybe a
Just (p
c p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
cs)
       in (Maybe [p] -> Maybe [p]) -> k -> Map k [p] -> Map k [p]
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 [] ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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 [] ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Arg -> [Either TemplateClass Class]
classFromArg ([Arg] -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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_params :: [String]
tmf_ret :: Types
tmf_name :: String
tmf_args :: [Arg]
tmf_alias :: Maybe String
tmf_params :: TemplateMemberFunction -> [String]
tmf_ret :: TemplateMemberFunction -> Types
tmf_name :: TemplateMemberFunction -> String
tmf_args :: TemplateMemberFunction -> [Arg]
tmf_alias :: TemplateMemberFunction -> Maybe String
..}) =
  [Either TemplateClass Class]
-> [Either TemplateClass Class] -> Dep4Func
Dep4Func (Types -> [Either TemplateClass Class]
extractClassFromType Types
tmf_ret) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Types -> [Either TemplateClass Class]
extractClassFromType (Types -> [Either TemplateClass Class])
-> (Arg -> Types) -> Arg -> [Either TemplateClass Class]
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_ret :: Types
toplevelfunc_name :: String
toplevelfunc_args :: [Arg]
toplevelfunc_alias :: Maybe String
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_alias :: TLOrdinary -> Maybe String
..} -> Types
toplevelfunc_ret
      TopLevelVariable {String
Maybe String
Types
toplevelvar_ret :: Types
toplevelvar_name :: String
toplevelvar_alias :: Maybe String
toplevelvar_ret :: TLOrdinary -> Types
toplevelvar_name :: TLOrdinary -> String
toplevelvar_alias :: TLOrdinary -> Maybe String
..} -> Types
toplevelvar_ret
    args :: [Arg]
args = case TLOrdinary
f of
      TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_ret :: Types
toplevelfunc_name :: String
toplevelfunc_args :: [Arg]
toplevelfunc_alias :: Maybe String
..} -> [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) ((Arg -> [Either TemplateClass Class])
-> [Arg] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Types -> [Either TemplateClass Class]
extractClassFromType (Types -> [Either TemplateClass Class])
-> (Arg -> Types) -> Arg -> [Either TemplateClass Class]
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 = (Class -> Either a Class) -> [Class] -> [Either a Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either a Class
forall a b. b -> Either a b
Right (Class -> [Class]
class_allparents Class
cls)
      alldeps' :: [Either TemplateClass Class]
alldeps' = (Either TemplateClass Class -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either TemplateClass Class -> [Either TemplateClass Class]
go [Either TemplateClass Class]
forall {a}. [Either a Class]
ps [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> Either TemplateClass Class -> [Either TemplateClass Class]
go (Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
cls)
      depSelf :: Either a (ClassSubmoduleType, Class)
depSelf = (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls)
   in UClassSubmodule
forall {a}. Either a (ClassSubmoduleType, Class)
depSelf UClassSubmodule -> [UClassSubmodule] -> [UClassSubmodule]
forall a. a -> [a] -> [a]
: ((Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
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] -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Class -> Either TemplateClass Class
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 (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
            [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
            [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (Variable -> [Either TemplateClass Class])
-> [Variable] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Arg -> [Either TemplateClass Class]
classFromArg (Arg -> [Either TemplateClass Class])
-> (Variable -> Arg) -> Variable -> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Arg
unVariable) [Variable]
vs
            [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
            [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
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 (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
            [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
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 [UClassSubmodule] -> [UClassSubmodule] -> [UClassSubmodule]
forall a. Semigroup a => a -> a -> a
<> [UClassSubmodule]
inplaces
  where
    raws' :: [Either TemplateClass Class]
raws' =
      [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
        (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= TemplateClass -> Either TemplateClass Class
forall a b. a -> Either a b
Left TemplateClass
tcl) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
          (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) ([TemplateFunction] -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
            TemplateClass -> [TemplateFunction]
tclass_funcs TemplateClass
tcl
    raws :: [UClassSubmodule]
raws =
      case TemplateClassSubmoduleType
typ of
        TemplateClassSubmoduleType
TCSTTemplate ->
          (Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
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 ->
          (Either TemplateClass Class -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            ( \case
                Left TemplateClass
t -> [(TemplateClassSubmoduleType, TemplateClass) -> UClassSubmodule
forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, TemplateClass
t)]
                Right Class
c -> (ClassSubmoduleType -> UClassSubmodule)
-> [ClassSubmoduleType] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right ((ClassSubmoduleType, Class) -> UClassSubmodule)
-> (ClassSubmoduleType -> (ClassSubmoduleType, Class))
-> ClassSubmoduleType
-> UClassSubmodule
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 (Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) ([Either TemplateClass Class] -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$
            [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
              (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isInSamePackageButNotInheritedBy` TemplateClass -> Either TemplateClass Class
forall a b. a -> Either a b
Left TemplateClass
tcl) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
                (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
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 =
        (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) ([Function] -> [Function]
virtualFuncs ([Function] -> [Function]) -> [Function] -> [Function]
forall a b. (a -> b) -> a -> b
$ Class -> [Function]
class_funcs Class
cls)
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. [a] -> [a] -> [a]
++ (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
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 =
        (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) ([Function] -> [Function]
virtualFuncs ([Function] -> [Function]) -> [Function] -> [Function]
forall a b. (a -> b) -> a -> b
$ Class -> [Function]
class_funcs Class
cls)
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. [a] -> [a] -> [a]
++ (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
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 = (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls)
      raws :: [UClassSubmodule]
raws =
        (Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
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] -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
cls) [Either TemplateClass Class]
retDepClasses
      exts :: [UClassSubmodule]
exts =
        let extclasses :: [Either TemplateClass Class]
extclasses =
              (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isNotInSamePackageWith` Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
cls) [Either TemplateClass Class]
argDepClasses
            parents :: [Either a Class]
parents = (Class -> Either a Class) -> [Class] -> [Either a Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either a Class
forall a b. b -> Either a b
Right (Class -> [Class]
class_parents Class
cls)
         in (Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) ([Either TemplateClass Class] -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class]
forall {a}. [Either a Class]
parents [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> [Either TemplateClass Class]
extclasses)
      inplaces :: [UClassSubmodule]
inplaces =
        (Either TemplateClass Class -> UClassSubmodule)
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplateClass -> (TemplateClassSubmoduleType, TemplateClass))
-> (Class -> (ClassSubmoduleType, Class))
-> Either TemplateClass Class
-> UClassSubmodule
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType
TCSTTemplate,) (ClassSubmoduleType
CSTInterface,)) ([Either TemplateClass Class] -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$
          [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
            (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
`isInSamePackageButNotInheritedBy` Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
cls) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class]
argDepClasses
   in UClassSubmodule
forall {a}. Either a (ClassSubmoduleType, Class)
rawSelf UClassSubmodule -> [UClassSubmodule] -> [UClassSubmodule]
forall a. a -> [a] -> [a]
: ([UClassSubmodule]
raws [UClassSubmodule] -> [UClassSubmodule] -> [UClassSubmodule]
forall a. [a] -> [a] -> [a]
++ [UClassSubmodule]
exts [UClassSubmodule] -> [UClassSubmodule] -> [UClassSubmodule]
forall a. [a] -> [a] -> [a]
++ [UClassSubmodule]
inplaces)
calculateDependency (Right (ClassSubmoduleType
CSTCast, Class
cls)) = [(ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls), (ClassSubmoduleType, Class) -> UClassSubmodule
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 =
        [ (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
cls),
          (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTFFI, Class
cls),
          (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
cls),
          (ClassSubmoduleType, Class) -> Either a (ClassSubmoduleType, Class)
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
cls)
        ]
      dsFFI :: [Either TemplateClass Class]
dsFFI = (UClassSubmodule -> Either TemplateClass Class)
-> [UClassSubmodule] -> [Either TemplateClass Class]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TemplateClassSubmoduleType, TemplateClass) -> TemplateClass)
-> ((ClassSubmoduleType, Class) -> Class)
-> UClassSubmodule
-> Either TemplateClass Class
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TemplateClassSubmoduleType, TemplateClass) -> TemplateClass
forall a b. (a, b) -> b
snd (ClassSubmoduleType, Class) -> Class
forall a b. (a, b) -> b
snd) ([UClassSubmodule] -> [Either TemplateClass Class])
-> [UClassSubmodule] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ Class -> [UClassSubmodule]
mkDepFFI Class
cls
      dsParents :: [Either TemplateClass Class]
dsParents = [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ (Class -> Either TemplateClass Class)
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right ([Class] -> [Either TemplateClass Class])
-> [Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ Class -> [Class]
class_allparents Class
cls
      dsNonParents :: [Either TemplateClass Class]
dsNonParents = (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Either TemplateClass Class -> Bool)
-> Either TemplateClass Class
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either TemplateClass Class
 -> [Either TemplateClass Class] -> Bool)
-> [Either TemplateClass Class]
-> Either TemplateClass Class
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either TemplateClass Class -> [Either TemplateClass Class] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Either TemplateClass Class]
dsParents)) [Either TemplateClass Class]
dsFFI

      deps :: [UClassSubmodule]
deps =
        (Either TemplateClass Class -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \case
              Left TemplateClass
t -> [(TemplateClassSubmoduleType, TemplateClass) -> UClassSubmodule
forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, TemplateClass
t)]
              Right Class
c ->
                [ (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTRawType, Class
c),
                  (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
c),
                  (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
c)
                ]
          )
          ([Either TemplateClass Class]
dsNonParents [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> [Either TemplateClass Class]
dsParents)
   in [UClassSubmodule]
forall {a}. [Either a (ClassSubmoduleType, Class)]
depsSelf [UClassSubmodule] -> [UClassSubmodule] -> [UClassSubmodule]
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 Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) Bool -> Bool -> Bool
&& (Either TemplateClass Class -> CabalName
getPkgName Either TemplateClass Class
x CabalName -> CabalName -> Bool
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 Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Either TemplateClass Class
x Either TemplateClass Class -> [Either TemplateClass Class] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Either TemplateClass Class -> [Either TemplateClass Class]
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 CabalName -> CabalName -> Bool
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 [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class]
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
        (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (Function -> [Either TemplateClass Class])
-> [Function] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (Function -> Dep4Func)
-> Function
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dep4Func
extractClassDep) [Function]
fs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (Variable -> [Either TemplateClass Class])
-> [Variable] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Arg -> [Either TemplateClass Class]
classFromArg (Arg -> [Either TemplateClass Class])
-> (Variable -> Arg) -> Variable -> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Arg
unVariable) [Variable]
vs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateMemberFunction -> [Either TemplateClass Class])
-> [TemplateMemberFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateMemberFunction -> Dep4Func)
-> TemplateMemberFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateMemberFunction -> Dep4Func
extractClassDep4TmplMemberFun) [TemplateMemberFunction]
tmfs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> Either TemplateClass Class -> [Either TemplateClass Class]
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 [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Eq a => [a] -> [a]
L.nub ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class]
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter (Either TemplateClass Class -> Either TemplateClass Class -> Bool
forall a. Eq a => a -> a -> Bool
/= Either TemplateClass Class
y) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$
        (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> (TemplateFunction -> [Either TemplateClass Class])
-> [TemplateFunction] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TemplateFunction -> Dep4Func)
-> TemplateFunction
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateFunction -> Dep4Func
extractClassDepForTmplFun) [TemplateFunction]
fs
          [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. Semigroup a => a -> a -> a
<> Either TemplateClass Class -> [Either TemplateClass Class]
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 [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
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) = [(TemplateClassSubmoduleType, b)
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, b
tcl)]
      mkTags (Right t
cls) = (ClassSubmoduleType
 -> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t))
-> [ClassSubmoduleType]
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClassSubmoduleType, t)
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall a b. b -> Either a b
Right ((ClassSubmoduleType, t)
 -> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t))
-> (ClassSubmoduleType -> (ClassSubmoduleType, t))
-> ClassSubmoduleType
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,t
cls)) [ClassSubmoduleType
CSTRawType, ClassSubmoduleType
CSTCast, ClassSubmoduleType
CSTInterface]
   in (Either TemplateClass Class -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either TemplateClass Class -> [UClassSubmodule]
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 [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
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) = [(TemplateClassSubmoduleType, b)
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall a b. a -> Either a b
Left (TemplateClassSubmoduleType
TCSTTemplate, b
tcl)]
      mkTags (Right t
cls) = (ClassSubmoduleType
 -> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t))
-> [ClassSubmoduleType]
-> [Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClassSubmoduleType, t)
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall a b. b -> Either a b
Right ((ClassSubmoduleType, t)
 -> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t))
-> (ClassSubmoduleType -> (ClassSubmoduleType, t))
-> ClassSubmoduleType
-> Either (TemplateClassSubmoduleType, b) (ClassSubmoduleType, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,t
cls)) [ClassSubmoduleType
CSTRawType, ClassSubmoduleType
CSTCast, ClassSubmoduleType
CSTInterface]
   in (Either TemplateClass Class -> [UClassSubmodule])
-> [Either TemplateClass Class] -> [UClassSubmodule]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either TemplateClass Class -> [UClassSubmodule]
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 (UClassSubmodule -> [UClassSubmodule])
-> UClassSubmodule -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTInterface, Class
c),
      cmImportedSubmodulesForFFI :: [UClassSubmodule]
cmImportedSubmodulesForFFI = UClassSubmodule -> [UClassSubmodule]
calculateDependency (UClassSubmodule -> [UClassSubmodule])
-> UClassSubmodule -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTFFI, Class
c),
      cmImportedSubmodulesForCast :: [UClassSubmodule]
cmImportedSubmodulesForCast = UClassSubmodule -> [UClassSubmodule]
calculateDependency (UClassSubmodule -> [UClassSubmodule])
-> UClassSubmodule -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTCast, Class
c),
      cmImportedSubmodulesForImplementation :: [UClassSubmodule]
cmImportedSubmodulesForImplementation = UClassSubmodule -> [UClassSubmodule]
calculateDependency (UClassSubmodule -> [UClassSubmodule])
-> UClassSubmodule -> [UClassSubmodule]
forall a b. (a -> b) -> a -> b
$ (ClassSubmoduleType, Class) -> UClassSubmodule
forall a b. b -> Either a b
Right (ClassSubmoduleType
CSTImplementation, Class
c),
      cmExtraImport :: [String]
cmExtraImport = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (String -> [(String, [String])] -> Maybe [String]
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 =
  ModuleUnitImports -> Maybe ModuleUnitImports -> ModuleUnitImports
forall a. a -> Maybe a -> a
fromMaybe ModuleUnitImports
emptyModuleUnitImports (ModuleUnit
-> HashMap ModuleUnit ModuleUnitImports -> Maybe ModuleUnitImports
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 = (Class -> ClassModule) -> [Class] -> [ClassModule]
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) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Class -> String
class_name (ClassImportHeader -> Class
cihClass ClassImportHeader
y)
      cihs :: [ClassImportHeader]
cihs = (ClassImportHeader -> ClassImportHeader -> Bool)
-> [ClassImportHeader] -> [ClassImportHeader]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy ClassImportHeader -> ClassImportHeader -> Bool
cmpfunc ((ClassModule -> ClassImportHeader)
-> [ClassModule] -> [ClassImportHeader]
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 = (TemplateClassImportHeader -> TemplateClassModule)
-> [TemplateClassImportHeader] -> [TemplateClassModule]
forall a b. (a -> b) -> [a] -> [b]
map TemplateClassImportHeader -> TemplateClassModule
mkTCM [TemplateClassImportHeader]
ts
      tcihs :: [TemplateClassImportHeader]
tcihs = (TemplateClassModule -> TemplateClassImportHeader)
-> [TemplateClassModule] -> [TemplateClassImportHeader]
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 (Cabal -> String) -> (Class -> Cabal) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, String) -> String
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 (Cabal -> String) -> (Class -> Cabal) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String, String) -> String
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 (Cabal -> CabalName) -> (Class -> Cabal) -> Class -> CabalName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Cabal
class_cabal) Class
c
      extclasses :: [Either TemplateClass Class]
extclasses = (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CabalName -> CabalName -> Bool
forall a. Eq a => a -> a -> Bool
/= CabalName
pkgname) (CabalName -> Bool)
-> (Either TemplateClass Class -> CabalName)
-> Either TemplateClass Class
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) ([Either TemplateClass Class] -> [Either TemplateClass Class])
-> (Either TemplateClass Class -> [Either TemplateClass Class])
-> Either TemplateClass Class
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp (Either TemplateClass Class -> [Either TemplateClass Class])
-> Either TemplateClass Class -> [Either TemplateClass Class]
forall a b. (a -> b) -> a -> b
$ Class -> Either TemplateClass Class
forall a b. b -> Either a b
Right Class
c
      extheaders :: [String]
extheaders = [String] -> [String]
forall a. Eq a => [a] -> [a]
L.nub ([String] -> [String])
-> ([Either TemplateClass Class] -> [String])
-> [Either TemplateClass Class]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either TemplateClass Class -> String)
-> [Either TemplateClass Class] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Type.h") (String -> String)
-> (Either TemplateClass Class -> String)
-> Either TemplateClass Class
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalName -> String
unCabalName (CabalName -> String)
-> (Either TemplateClass Class -> CabalName)
-> Either TemplateClass Class
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) ([Either TemplateClass Class] -> [String])
-> [Either TemplateClass Class] -> [String]
forall a b. (a -> b) -> a -> b
$ [Either TemplateClass Class]
extclasses
   in (Class -> HeaderName) -> [Class] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map Class -> HeaderName
mkPkgHeaderFileName (Class -> [Class]
class_allparents Class
c) [HeaderName] -> [HeaderName] -> [HeaderName]
forall a. Semigroup a => a -> a -> a
<> (String -> HeaderName) -> [String] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map String -> HeaderName
HdrName [String]
extheaders

-- |
mkPkgIncludeHeadersInCPP :: Class -> [HeaderName]
mkPkgIncludeHeadersInCPP :: Class -> [HeaderName]
mkPkgIncludeHeadersInCPP = (Class -> HeaderName) -> [Class] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map Class -> HeaderName
mkPkgHeaderFileName ([Class] -> [HeaderName])
-> (Class -> [Class]) -> Class -> [HeaderName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either TemplateClass Class] -> [Class]
forall a b. [Either a b] -> [b]
rights ([Either TemplateClass Class] -> [Class])
-> (Class -> [Either TemplateClass Class]) -> Class -> [Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> [Either TemplateClass Class]
mkModuleDepCpp (Either TemplateClass Class -> [Either TemplateClass Class])
-> (Class -> Either TemplateClass Class)
-> Class
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Either TemplateClass Class
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 (ModuleUnitImports -> [Namespace])
-> (Class -> ModuleUnitImports) -> Class -> [Namespace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleUnit -> ModuleUnitImports
getImports (ModuleUnit -> ModuleUnitImports)
-> (Class -> ModuleUnit) -> Class -> ModuleUnitImports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleUnit
MU_Class (String -> ModuleUnit) -> (Class -> String) -> Class -> ModuleUnit
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 (Class -> Either TemplateClass Class
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 (ModuleUnitImports -> [HeaderName])
-> (Class -> ModuleUnitImports) -> Class -> [HeaderName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleUnit -> ModuleUnitImports
getImports (ModuleUnit -> ModuleUnitImports)
-> (Class -> ModuleUnit) -> Class -> ModuleUnitImports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModuleUnit
MU_Class (String -> ModuleUnit) -> (Class -> String) -> Class -> ModuleUnit
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 = (TLOrdinary -> [Either TemplateClass Class])
-> [TLOrdinary] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
argumentDependency (Dep4Func -> [Either TemplateClass Class])
-> (TLOrdinary -> Dep4Func)
-> TLOrdinary
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary) [TLOrdinary]
ofs
      tl_cs2 :: [Either TemplateClass Class]
tl_cs2 = (TLOrdinary -> [Either TemplateClass Class])
-> [TLOrdinary] -> [Either TemplateClass Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Dep4Func -> [Either TemplateClass Class]
returnDependency (Dep4Func -> [Either TemplateClass Class])
-> (TLOrdinary -> Dep4Func)
-> TLOrdinary
-> [Either TemplateClass Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLOrdinary -> Dep4Func
extractClassDepForTLOrdinary) [TLOrdinary]
ofs
      tl_cs :: [Either TemplateClass Class]
tl_cs = (Either TemplateClass Class -> Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Either TemplateClass Class -> String)
-> Either TemplateClass Class
-> Either TemplateClass Class
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (TemplateClass -> String)
-> (Class -> String) -> Either TemplateClass Class -> String
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 [Either TemplateClass Class]
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
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 = [Maybe ClassImportHeader] -> [ClassImportHeader]
forall a. [Maybe a] -> [a]
catMaybes ((Either TemplateClass Class
 -> [Maybe ClassImportHeader] -> [Maybe ClassImportHeader])
-> [Maybe ClassImportHeader]
-> [Either TemplateClass Class]
-> [Maybe ClassImportHeader]
forall a b. (a -> b -> b) -> b -> [a] -> b
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 = (ClassImportHeader -> Bool)
-> [ClassImportHeader] -> Maybe ClassImportHeader
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\ClassImportHeader
x -> (Class -> String
ffiClassName (Class -> String)
-> (ClassImportHeader -> Class) -> ClassImportHeader -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassImportHeader -> Class
cihClass) ClassImportHeader
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Either TemplateClass Class -> String
getFFIName Either TemplateClass Class
c) [ClassImportHeader]
cihs
             in Maybe ClassImportHeader
y Maybe ClassImportHeader
-> [Maybe ClassImportHeader] -> [Maybe ClassImportHeader]
forall a. a -> [a] -> [a]
: [Maybe ClassImportHeader]
ys
      -- NOTE: The remaining class dependencies outside the current package
      extclasses :: [Either TemplateClass Class]
extclasses = (Either TemplateClass Class -> Bool)
-> [Either TemplateClass Class] -> [Either TemplateClass Class]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CabalName -> CabalName -> Bool
forall a. Eq a => a -> a -> Bool
/= CabalName
pkgname) (CabalName -> Bool)
-> (Either TemplateClass Class -> CabalName)
-> Either TemplateClass Class
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TemplateClass Class -> CabalName
getPkgName) [Either TemplateClass Class]
tl_cs
      extheaders :: [HeaderName]
extheaders =
        (String -> HeaderName) -> [String] -> [HeaderName]
forall a b. (a -> b) -> [a] -> [b]
map String -> HeaderName
HdrName ([String] -> [HeaderName]) -> [String] -> [HeaderName]
forall a b. (a -> b) -> a -> b
$
          [String] -> [String]
forall a. Eq a => [a] -> [a]
L.nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
            (Either TemplateClass Class -> String)
-> [Either TemplateClass Class] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Type.h") (String -> String)
-> (Either TemplateClass Class -> String)
-> Either TemplateClass Class
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalName -> String
unCabalName (CabalName -> String)
-> (Either TemplateClass Class -> CabalName)
-> Either TemplateClass Class
-> String
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 String -> String -> String
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)
        }