Show generated module dependency graph (#203)

This PR provides drawDepGraph utility function which generates a dot graph string showing the dependencies of all the generated Haskell modules.
As cyclic dependency treatment is not correct, I disabled {-# SOURCE #-} pragma for now.

* language extension for hs-boot files
* drawDepGraph
* draw RawType/Template dep
* rename mkModuleDepHighSource by mkModuleDepHighInplace
* disable incorrect import {-# SOURCE #-}
* show raw self dep and inplace deps
* rename cmImportedModulesHigh.. to cmImportedModules.., (drop High)
rename NonSource -> External
* FFI dependency graph added
* show Implementation dependency
* show dependency of Template/TH modules.
* top-level function depedency!
* format with ormolu.

fficxx/fficxx.cabal

@@ -25,6 +25,7 @@ Library
                , containers
                , data-default
                , directory
+               , dotgen
                , errors
                , fficxx-runtime
                , filepath>1
@@ -56,6 +57,7 @@ Library
                FFICXX.Generate.Name
                FFICXX.Generate.QQ.Verbatim
                FFICXX.Generate.Util
+               FFICXX.Generate.Util.DepGraph
                FFICXX.Generate.Util.HaskellSrcExts
                FFICXX.Generate.Type.Annotate
                FFICXX.Generate.Type.Cabal

fficxx/src/FFICXX/Generate/Code/HsFFI.hs

@@ -91,7 +91,7 @@ hsFFIAccessor c v a =
 -- import for FFI
 
 genImportInFFI :: ClassModule -> [ImportDecl ()]
-genImportInFFI = map mkMod . cmImportedModulesForFFI
+genImportInFFI = map mkMod . cmImportedModulesFFI
   where
     mkMod (Left t) = mkImport (getTClassModuleBase t <.> "Template")
     mkMod (Right c) = mkImport (getClassModuleBase c <.> "RawType")

fficxx/src/FFICXX/Generate/Code/HsFrontEnd.hs

@@ -80,7 +80,7 @@ import FFICXX.Generate.Util.HaskellSrcExts
     mkFun,
     mkFunSig,
     mkImport,
-    mkImportSrc,
+    -- mkImportSrc,
     mkInstance,
     mkNewtype,
     mkPVar,
@@ -323,35 +323,37 @@ genExtraImport cm = map mkImport (cmExtraImport cm)
 genImportInModule :: Class -> [ImportDecl ()]
 genImportInModule x = map (\y -> mkImport (getClassModuleBase x <.> y)) ["RawType", "Interface", "Implementation"]
 
+-- TODO: this dependency should be refactored out and analyzed separately, particularly for cyclic deps.
 genImportInInterface :: ClassModule -> [ImportDecl ()]
 genImportInInterface m =
-  let modlstraw = cmImportedModulesRaw m
-      modlstparent = cmImportedModulesHighNonSource m
-      modlsthigh = cmImportedModulesHighSource m
+  let modsRaw = cmImportedModulesRaw m
+      modsExt = cmImportedModulesExternal m
+      modsInplace = cmImportedModulesInplace m
    in [mkImport (cmModule m <.> "RawType")]
         <> flip
           map
-          modlstraw
+          modsRaw
           ( \case
               Left t -> mkImport (getTClassModuleBase t <.> "Template")
               Right c -> mkImport (getClassModuleBase c <.> "RawType")
           )
         <> flip
           map
-          modlstparent
+          modsExt
           ( \case
               Left t -> mkImport (getTClassModuleBase t <.> "Template")
               Right c -> mkImport (getClassModuleBase c <.> "Interface")
           )
         <> flip
           map
-          modlsthigh
+          modsInplace
           ( \case
               Left t ->
                 -- TODO: *.Template in the same package needs to have hs-boot.
                 --       Currently, we do not have it yet.
                 mkImport (getTClassModuleBase t <.> "Template")
-              Right c -> mkImportSrc (getClassModuleBase c <.> "Interface")
+              Right c -> mkImport (getClassModuleBase c <.> "Interface")
+              -- mkImportSrc (getClassModuleBase c <.> "Interface")
           )
 
 -- |
@@ -364,20 +366,21 @@ genImportInCast m =
 -- |
 genImportInImplementation :: ClassModule -> [ImportDecl ()]
 genImportInImplementation m =
-  let modlstraw' = cmImportedModulesForFFI m
-      modlsthigh = nub $ map Right $ class_allparents $ cihClass $ cmCIH m
-      modlstraw = filter (not . (flip elem modlsthigh)) modlstraw'
+  let modsFFI = cmImportedModulesFFI m
+      modsParents = nub $ map Right $ class_allparents $ cihClass $ cmCIH m
+      modsNonParents = filter (not . (flip elem modsParents)) modsFFI
    in [ mkImport (cmModule m <.> "RawType"),
         mkImport (cmModule m <.> "FFI"),
         mkImport (cmModule m <.> "Interface"),
         mkImport (cmModule m <.> "Cast")
       ]
-        <> concatMap (\case Left t -> [mkImport (getTClassModuleBase t <.> "Template")]; Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]) modlstraw
-        <> concatMap (\case Left t -> [mkImport (getTClassModuleBase t <.> "Template")]; Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]) modlsthigh
+        <> concatMap (\case Left t -> [mkImport (getTClassModuleBase t <.> "Template")]; Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]) modsNonParents
+        <> concatMap (\case Left t -> [mkImport (getTClassModuleBase t <.> "Template")]; Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]) modsParents
 
 -- | generate import list for a given top-level ordinary function
 --   currently this may generate duplicate import list.
 -- TODO: eliminate duplicated imports.
+-- TODO2: should be refactored out.
 genImportForTLOrdinary :: TLOrdinary -> [ImportDecl ()]
 genImportForTLOrdinary f =
   let dep4func = extractClassDepForTLOrdinary f
@@ -390,6 +393,7 @@ genImportForTLOrdinary f =
 -- | generate import list for a given top-level template function
 --   currently this may generate duplicate import list.
 -- TODO: eliminate duplicated imports.
+-- TODO2: should be refactored out.
 genImportForTLTemplate :: TLTemplate -> [ImportDecl ()]
 genImportForTLTemplate f =
   let dep4func = extractClassDepForTLTemplate f

fficxx/src/FFICXX/Generate/Code/HsTemplate.hs

@@ -22,7 +22,7 @@ import FFICXX.Generate.Code.Primitive
 import FFICXX.Generate.Dependency
   ( getClassModuleBase,
     getTClassModuleBase,
-    mkModuleDepHighSource,
+    mkModuleDepInplace,
     mkModuleDepRaw,
   )
 import FFICXX.Generate.Name
@@ -236,18 +236,18 @@ genTMFInstance cih f =
 
 genImportInTemplate :: TemplateClass -> [ImportDecl ()]
 genImportInTemplate t0 =
-  let deps_raw = mkModuleDepRaw (Left t0)
-      deps_high = mkModuleDepHighSource (Left t0)
+  let depsRaw = mkModuleDepRaw (Left t0)
+      depsInplace = mkModuleDepInplace (Left t0)
    in flip
         map
-        deps_raw
+        depsRaw
         ( \case
             Left t -> mkImport (getTClassModuleBase t <.> "Template")
             Right c -> mkImport (getClassModuleBase c <.> "RawType")
         )
         <> flip
           map
-          deps_high
+          depsInplace
           ( \case
               Left t -> mkImport (getTClassModuleBase t <.> "Template")
               Right c -> mkImport (getClassModuleBase c <.> "Interface")
@@ -288,18 +288,18 @@ genTmplInterface t =
 -- |
 genImportInTH :: TemplateClass -> [ImportDecl ()]
 genImportInTH t0 =
-  let deps_raw = mkModuleDepRaw (Left t0)
-      deps_high = mkModuleDepHighSource (Left t0)
+  let depsRaw = mkModuleDepRaw (Left t0)
+      depsInplace = mkModuleDepInplace (Left t0)
    in flip
         concatMap
-        deps_raw
+        depsRaw
         ( \case
             Left t -> [mkImport (getTClassModuleBase t <.> "Template")]
             Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]
         )
         <> flip
           concatMap
-          deps_high
+          depsInplace
           ( \case
               Left t -> [mkImport (getTClassModuleBase t <.> "Template")]
               Right c -> map (\y -> mkImport (getClassModuleBase c <.> y)) ["RawType", "Cast", "Interface"]

fficxx/src/FFICXX/Generate/ContentMaker.hs

@@ -427,7 +427,22 @@ buildInterfaceHs amap m =
 -- |
 buildInterfaceHsBoot :: ClassModule -> Module ()
 buildInterfaceHsBoot m =
-  mkModule (cmModule m <.> "Interface") [] hsbootImports hsbootBody
+  mkModule
+    (cmModule m <.> "Interface")
+    [ lang
+        [ "EmptyDataDecls",
+          "ExistentialQuantification",
+          "FlexibleContexts",
+          "FlexibleInstances",
+          "ForeignFunctionInterface",
+          "MultiParamTypeClasses",
+          "ScopedTypeVariables",
+          "TypeFamilies",
+          "TypeSynonymInstances"
+        ]
+    ]
+    hsbootImports
+    hsbootBody
   where
     c = cihClass (cmCIH m)
     hsbootImports =

fficxx/src/FFICXX/Generate/Dependency.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 
 module FFICXX.Generate.Dependency where
 
@@ -25,7 +26,13 @@ import qualified Data.HashMap.Strict as HM
 import Data.List (find, foldl', nub, nubBy)
 import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
-import FFICXX.Generate.Name (ffiClassName, hsClassName, hsTemplateClassName)
+import FFICXX.Generate.Name
+  ( ClassModuleType (..),
+    TemplateClassModuleType (..),
+    ffiClassName,
+    hsClassName,
+    hsTemplateClassName,
+  )
 import FFICXX.Generate.Type.Cabal
   ( AddCInc,
     AddCSrc,
@@ -232,31 +239,30 @@ isInSamePackageButNotInheritedBy x y =
 -- TODO: Confirm the following answer
 -- NOTE: Q: why returnDependency is not considered?
 --       A: See explanation in mkModuleDepRaw
-mkModuleDepHighNonSource :: Either TemplateClass Class -> [Either TemplateClass Class]
-mkModuleDepHighNonSource y@(Right c) =
+mkModuleDepExternal :: Either TemplateClass Class -> [Either TemplateClass Class]
+mkModuleDepExternal y@(Right c) =
   let extclasses =
         filter (`isNotInSamePackageWith` y) $
           concatMap (argumentDependency . extractClassDep) (class_funcs c)
             ++ concatMap (argumentDependency . extractClassDep4TmplMemberFun) (class_tmpl_funcs c)
       parents = map Right (class_parents c)
    in nub (parents <> extclasses)
-mkModuleDepHighNonSource y@(Left t) =
+mkModuleDepExternal y@(Left t) =
   let fs = tclass_funcs t
       extclasses =
         filter (`isNotInSamePackageWith` y) $
           concatMap (argumentDependency . extractClassDepForTmplFun) fs
    in nub extclasses
 
--- TODO: Confirm the following answer
 -- NOTE: Q: why returnDependency is not considered?
 --       A: See explanation in mkModuleDepRaw
-mkModuleDepHighSource :: Either TemplateClass Class -> [Either TemplateClass Class]
-mkModuleDepHighSource y@(Right c) =
+mkModuleDepInplace :: Either TemplateClass Class -> [Either TemplateClass Class]
+mkModuleDepInplace y@(Right c) =
   nub $
     filter (`isInSamePackageButNotInheritedBy` y) $
       concatMap (argumentDependency . extractClassDep) (class_funcs c)
         ++ concatMap (argumentDependency . extractClassDep4TmplMemberFun) (class_tmpl_funcs c)
-mkModuleDepHighSource y@(Left t) =
+mkModuleDepInplace y@(Left t) =
   let fs = tclass_funcs t
    in nub $
         filter (`isInSamePackageButNotInheritedBy` y) $
@@ -306,6 +312,26 @@ mkModuleDepFFI y@(Right c) =
    in nub (filter (/= y) alldeps')
 mkModuleDepFFI (Left _) = []
 
+-- | Find module-level dependency per each toplevel function/template function.
+mkTopLevelDep ::
+  TopLevel ->
+  [ Either
+      (TemplateClassModuleType, TemplateClass)
+      (ClassModuleType, Class)
+  ]
+mkTopLevelDep (TLOrdinary f) =
+  let dep4func = extractClassDepForTLOrdinary f
+      allDeps = returnDependency dep4func ++ argumentDependency dep4func
+      mkTags (Left tcl) = [Left (TCMTTemplate, tcl)]
+      mkTags (Right cls) = fmap (Right . (,cls)) [CMTRawType, CMTCast, CMTInterface]
+   in concatMap mkTags allDeps
+mkTopLevelDep (TLTemplate f) =
+  let dep4func = extractClassDepForTLTemplate f
+      allDeps = returnDependency dep4func ++ argumentDependency dep4func
+      mkTags (Left tcl) = [Left (TCMTTemplate, tcl)]
+      mkTags (Right cls) = fmap (Right . (,cls)) [CMTRawType, CMTCast, CMTInterface]
+   in concatMap mkTags allDeps
+
 -- |
 mkClassModule ::
   (ModuleUnit -> ModuleUnitImports) ->
@@ -316,16 +342,16 @@ mkClassModule getImports extra c =
   ClassModule
     { cmModule = getClassModuleBase c,
       cmCIH = mkCIH getImports c,
-      cmImportedModulesHighNonSource = highs_nonsource,
+      cmImportedModulesExternal = exts,
       cmImportedModulesRaw = raws,
-      cmImportedModulesHighSource = highs_source,
-      cmImportedModulesForFFI = ffis,
+      cmImportedModulesInplace = inplaces,
+      cmImportedModulesFFI = ffis,
       cmExtraImport = extraimports
     }
   where
-    highs_nonsource = mkModuleDepHighNonSource (Right c)
+    exts = mkModuleDepExternal (Right c)
     raws = mkModuleDepRaw (Right c)
-    highs_source = mkModuleDepHighSource (Right c)
+    inplaces = mkModuleDepInplace (Right c)
     ffis = mkModuleDepFFI (Right c)
     extraimports = fromMaybe [] (lookup (class_name c) extra)
 
@@ -371,7 +397,7 @@ mkPackageConfig (pkgname, getImports) (cs, fs, ts, extra) acincs acsrcs =
 mkHsBootCandidateList :: [ClassModule] -> [ClassModule]
 mkHsBootCandidateList ms =
   let -- get only class dependencies, not template classes.
-      cs = rights (concatMap cmImportedModulesHighSource ms)
+      cs = rights (concatMap cmImportedModulesInplace ms)
       candidateModBases = fmap getClassModuleBase cs
    in filter (\m -> cmModule m `elem` candidateModBases) ms
 

fficxx/src/FFICXX/Generate/Name.hs

@@ -22,6 +22,17 @@ import FFICXX.Generate.Type.Class
   )
 import FFICXX.Generate.Util (firstLower, toLowers)
 
+data ClassModuleType
+  = CMTRawType
+  | CMTInterface
+  | CMTImplementation
+  | CMTFFI
+  | CMTCast
+
+data TemplateClassModuleType
+  = TCMTTH
+  | TCMTTemplate
+
 hsFrontNameForTopLevel :: TopLevel -> String
 hsFrontNameForTopLevel tfn =
   let (x : xs) = case tfn of

fficxx/src/FFICXX/Generate/Type/Module.hs

@@ -30,15 +30,13 @@ data ClassImportHeader = ClassImportHeader
 data ClassModule = ClassModule
   { cmModule :: String,
     cmCIH :: ClassImportHeader,
-    -- | imported modules that do not need source
-    -- NOTE: source means the same cabal package.
-    -- TODO: rename Source to something more clear.
-    cmImportedModulesHighNonSource :: [Either TemplateClass Class],
+    -- | imported modules external to the current package unit.
+    cmImportedModulesExternal :: [Either TemplateClass Class],
     -- | imported modules for raw types.
     cmImportedModulesRaw :: [Either TemplateClass Class],
-    -- | imported modules that need source
-    cmImportedModulesHighSource :: [Either TemplateClass Class],
-    cmImportedModulesForFFI :: [Either TemplateClass Class],
+    -- | imported modules in the current package-in-place
+    cmImportedModulesInplace :: [Either TemplateClass Class],
+    cmImportedModulesFFI :: [Either TemplateClass Class],
     cmExtraImport :: [String]
   }
   deriving (Show)