Add depanalPartial to make getting a partial modgraph easier
authorDaniel Gröber <dxld@darkboxed.org>
Sun, 26 May 2019 09:28:34 +0000 (11:28 +0200)
committerBen Gamari <ben@well-typed.com>
Tue, 4 Jun 2019 03:42:12 +0000 (23:42 -0400)
As per @mpickering's suggestion on IRC this is to make the partial
module-graph more easily accessible for API clients which don't intend to
re-implementing depanal.

compiler/main/GhcMake.hs

index 1014448..d836cf2 100644 (file)
@@ -10,7 +10,7 @@
 --
 -- -----------------------------------------------------------------------------
 module GhcMake(
-        depanal,
+        depanal, depanalPartial,
         load, load', LoadHowMuch(..),
 
         downsweep,
@@ -48,7 +48,7 @@ import TcIface          ( typecheckIface )
 import TcRnMonad        ( initIfaceCheck )
 import HscMain
 
-import Bag              ( unitBag, listToBag, unionManyBags )
+import Bag              ( unitBag, listToBag, unionManyBags, isEmptyBag )
 import BasicTypes
 import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
@@ -121,6 +121,32 @@ depanal :: GhcMonad m =>
         -> Bool          -- ^ allow duplicate roots
         -> m ModuleGraph
 depanal excluded_mods allow_dup_roots = do
+    hsc_env <- getSession
+    (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots
+    if isEmptyBag errs
+      then do
+        warnMissingHomeModules hsc_env mod_graph
+        setSession hsc_env { hsc_mod_graph = mod_graph }
+        return mod_graph
+      else throwErrors errs
+
+
+-- | Perform dependency analysis like 'depanal' but return a partial module
+-- graph even in the face of problems with some modules.
+--
+-- Modules which have parse errors in the module header, failing
+-- preprocessors or other issues preventing them from being summarised will
+-- simply be absent from the returned module graph.
+--
+-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the
+-- new module graph.
+depanalPartial
+    :: GhcMonad m
+    => [ModuleName]  -- ^ excluded modules
+    -> Bool          -- ^ allow duplicate roots
+    -> m (ErrorMessages, ModuleGraph)
+    -- ^ possibly empty 'Bag' of errors and a module graph.
+depanalPartial excluded_mods allow_dup_roots = do
   hsc_env <- getSession
   let
          dflags  = hsc_dflags hsc_env
@@ -140,14 +166,10 @@ depanal excluded_mods allow_dup_roots = do
 
     mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph)
                                      excluded_mods allow_dup_roots
-    mod_summaries <- reportImportErrors mod_summariesE
-
-    let mod_graph = mkModuleGraph mod_summaries
-
-    warnMissingHomeModules hsc_env mod_graph
-
-    setSession hsc_env { hsc_mod_graph = mod_graph }
-    return mod_graph
+    let
+           (errs, mod_summaries) = partitionEithers mod_summariesE
+           mod_graph = mkModuleGraph mod_summaries
+    return (unionManyBags errs, mod_graph)
 
 -- Note [Missing home modules]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~