Add root-modules field

README.md

@@ -95,7 +95,8 @@ in the Dhall project).
 | ---------------- | ------------------------------------ | --- |
 | roots | `[ "Main.main", "^Paths_weeder.*" ]` | Any declarations matching these regular expressions will be considered as alive. |
 | type-class-roots | `false` | Consider all instances of type classes as roots. Overrides `root-instances`. |
-| root-instances | `[ {class = '\.IsString$'}, {class = '\.IsList$'} ]` | Type class instances that match on all specified fields will be considered as roots. Accepts the fields `instance` matching on the pretty-printed type of the instance (visible in the output), `class` matching on its parent class declaration, and `module` matching on the module the instance is in. |
+| root-instances | `[ {class = '\.IsString$'}, {class = '\.IsList$'} ]` | Type class instances that match on all specified fields will be considered as roots. Accepts the fields `instance` matching on the pretty-printed type of the instance (visible in the output), `class` matching on its parent class declaration, and `module` matching on the module the instance is defined in. |
+| root-modules | `[]` | The exports of all matching modules will be considered as alive. This does not include type class instances implicitly exported by the module.
 | unused-types | `false` | Enable analysis of unused types. |
 
 `root-instances` can also accept string literals as a shorthand for writing a table

src/Weeder.hs

@@ -56,6 +56,7 @@ import qualified Data.Tree as Tree
 import Data.Generics.Labels ()
 
 -- ghc
+import GHC.Types.Avail ( AvailInfo, availName, availNames )
 import GHC.Data.FastString ( unpackFS )
 import GHC.Iface.Ext.Types
  ( BindType( RegularBind )
@@ -64,7 +65,7 @@ import GHC.Iface.Ext.Types
  , EvVarSource ( EvInstBind, cls )
  , HieAST( Node, nodeChildren, nodeSpan, sourcedNodeInfo )
  , HieASTs( HieASTs )
- , HieFile( HieFile, hie_asts, hie_module, hie_hs_file, hie_types )
+ , HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file, hie_types )
  , HieType( HTyVarTy, HAppTy, HTyConApp, HForAllTy, HFunTy, HQualTy, HLitTy, HCastTy, HCoercionTy )
  , HieArgs( HieArgs )
  , HieTypeFix( Roll )
@@ -270,14 +271,16 @@ analyseHieFile weederConfig hieFile =
 
 analyseHieFile' :: ( MonadState Analysis m, MonadReader AnalysisInfo m ) => m ()
 analyseHieFile' = do
- HieFile{ hie_asts = HieASTs hieASTs, hie_module, hie_hs_file } <- asks currentHieFile
+ HieFile{ hie_asts = HieASTs hieASTs, hie_exports, hie_module, hie_hs_file } <- asks currentHieFile
  #modulePaths %= Map.insert hie_module hie_hs_file
 
  g <- asks initialGraph
  #dependencyGraph %= overlay g
 
  for_ hieASTs topLevelAnalysis
 
+ for_ hie_exports ( analyseExport hie_module )
+
 
 lookupType :: HieFile -> TypeIndex -> HieTypeFix
 lookupType hf t = recoverFullType t $ hie_types hf
@@ -324,6 +327,15 @@ typeToNames (Roll t) = case t of
  hieArgsTypes = foldMap (typeToNames . snd) . filter fst
 
 
+analyseExport :: MonadState Analysis m => Module -> AvailInfo -> m ()
+analyseExport m a = 
+ traverse_ (traverse_ addExport . nameToDeclaration) (availName a : availNames a)
+ where
+
+ addExport :: MonadState Analysis m => Declaration -> m ()
+ addExport d = #exports %= Map.insertWith (<>) m ( Set.singleton d )
+
+
 -- | @addDependency x y@ adds the information that @x@ depends on @y@.
 addDependency :: MonadState Analysis m => Declaration -> Declaration -> m ()
 addDependency x y =

src/Weeder/Config.hs

@@ -69,7 +69,9 @@ data ConfigType a = Config
  , unusedTypes :: Bool
  -- ^ Toggle to look for and output unused types. Type family instances will
  -- be marked as implicit roots.
- } deriving (Eq, Show)
+ , rootModules :: [a]
+ -- ^ All matching modules will be added to the root set.
+ } deriving (Eq, Show, Functor, Foldable, Traversable)
 
 
 -- | Construct via InstanceOnly, ClassOnly or ModuleOnly, 
@@ -100,6 +102,7 @@ defaultConfig = Config
  , typeClassRoots = False
  , rootInstances = [ ClassOnly "\\.IsString$", ClassOnly "\\.IsList$" ]
  , unusedTypes = False
+ , rootModules = mempty
  }
 
 
@@ -115,6 +118,7 @@ instance TOML.DecodeTOML ConfigParsed where
  typeClassRoots <- TOML.getFieldOr (typeClassRoots defaultConfig) "type-class-roots"
  rootInstances <- TOML.getFieldOr (rootInstances defaultConfig) "root-instances" 
  unusedTypes <- TOML.getFieldOr (unusedTypes defaultConfig) "unused-types"
+ rootModules <- TOML.getFieldOr (rootModules defaultConfig) "root-modules"
 
  pure Config{..}
 
@@ -125,6 +129,7 @@ decodeNoDefaults = do
  typeClassRoots <- TOML.getField "type-class-roots"
  rootInstances <- TOML.getField "root-instances"
  unusedTypes <- TOML.getField "unused-types"
+ rootModules <- TOML.getField "root-modules"
 
  either fail pure $ compileConfig Config{..}
 
@@ -181,10 +186,13 @@ compileRegex = bimap show (\p -> patternToRegex p defaultCompOpt defaultExecOpt)
 
 
 compileConfig :: ConfigParsed -> Either String Config
-compileConfig conf@Config{ rootInstances, rootPatterns } = do
- rootInstances' <- traverse (traverse compileRegex) . nubOrd $ rootInstances
- rootPatterns' <- traverse compileRegex $ nubOrd rootPatterns
- pure conf{ rootInstances = rootInstances', rootPatterns = rootPatterns' }
+compileConfig conf@Config{ rootInstances, rootPatterns, rootModules } = 
+ traverse compileRegex conf'
+ where
+ rootInstances' = nubOrd rootInstances
+ rootPatterns' = nubOrd rootPatterns
+ rootModules' = nubOrd rootModules
+ conf' = conf{ rootInstances = rootInstances', rootPatterns = rootPatterns', rootModules = rootModules' }
 
 
 configToToml :: ConfigParsed -> String
@@ -194,6 +202,7 @@ configToToml Config{..}
  , "type-class-roots = " ++ map toLower (show typeClassRoots)
  , "root-instances = " ++ "[" ++ intercalate "," (map showInstancePattern rootInstances') ++ "]"
  , "unused-types = " ++ map toLower (show unusedTypes)
+ , "root-modules = " ++ show rootModules
  ]
  where
  rootInstances' = rootInstances

src/Weeder/Run.hs

@@ -19,10 +19,10 @@ import qualified Data.Set as Set
 import qualified Data.Map.Strict as Map
 
 -- ghc
-import GHC.Plugins 
+import GHC.Plugins
  ( occNameString
  , moduleName
- , moduleNameString 
+ , moduleNameString
  )
 import GHC.Iface.Ext.Types ( HieFile( hie_asts ), getAsts )
 import GHC.Iface.Ext.Utils (generateReferencesMap)
@@ -62,7 +62,7 @@ formatWeed Weed{..} =
 -- Returns a list of 'Weed's that can be displayed using
 -- 'formatWeed', and the final 'Analysis'.
 runWeeder :: Config -> [HieFile] -> ([Weed], Analysis)
-runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances } hieFiles =
+runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances, rootModules } hieFiles =
  let 
  asts = concatMap (Map.elems . getAsts . hie_asts) hieFiles
 
@@ -96,11 +96,19 @@ runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances } hie
  rootPatterns
  )
  ( outputableDeclarations analysis )
+
+ matchingModules = 
+ Set.filter 
+ ((\s -> any (`matchTest` s) rootModules) . moduleNameString . moduleName) 
+ ( Map.keysSet $ exports analysis )
 
  reachableSet =
  reachable
  analysis
- ( Set.map DeclarationRoot roots <> filterImplicitRoots analysis ( implicitRoots analysis ) )
+ ( Set.map DeclarationRoot roots 
+ <> Set.map ModuleRoot matchingModules 
+ <> filterImplicitRoots analysis ( implicitRoots analysis ) 
+ )
 
  -- We only care about dead declarations if they have a span assigned,
  -- since they don't show up in the output otherwise

test/Spec/ModuleRoot.stdout

@@ -0,0 +1,2 @@
+test/Spec/ModuleRoot/InstanceNotRoot.hs:9: (Instance) :: C T
+test/Spec/ModuleRoot/M.hs:11: weed

test/Spec/ModuleRoot.toml

@@ -0,0 +1,5 @@
+roots = []
+
+root-modules = [ '^Spec\.ModuleRoot\.M$', '^Spec\.ModuleRoot\.InstanceNotRoot$' ]
+
+type-class-roots = false

test/Spec/ModuleRoot/InstanceNotRoot.hs

@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+module Spec.ModuleRoot.InstanceNotRoot (C(..), T(..)) where
+
+class C a where
+ method :: a -> a
+
+data T = T
+
+instance C T where
+ method = id

test/Spec/ModuleRoot/M.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+module Spec.ModuleRoot.M (root) where
+
+root :: ()
+root = dependency
+
+dependency :: ()
+dependency = ()
+
+weed :: ()
+weed = ()

test/UnitTests/Weeder/ConfigSpec.hs

@@ -20,6 +20,7 @@ prop_configToToml =
  , typeClassRoots = True
  , rootInstances = [InstanceOnly "Quux\\\\[\\]", ClassOnly "[\\[\\\\[baz" <> ModuleOnly "[Quuux]", InstanceOnly "[\\[\\\\[baz" <> ClassOnly "[Quuux]" <> ModuleOnly "[Quuuux]"]
  , unusedTypes = True
+ , rootModules = ["Foo\\.Bar", "Baz"]
  }
  cf' = T.pack $ configToToml cf
  in TOML.decode cf' == Right cf

weeder.cabal

@@ -92,6 +92,8 @@ test-suite weeder-test
  Spec.DeriveGeneric.DeriveGeneric
  Spec.InstanceRootConstraint.InstanceRootConstraint
  Spec.InstanceTypeclass.InstanceTypeclass
+ Spec.ModuleRoot.InstanceNotRoot
+ Spec.ModuleRoot.M
  Spec.Monads.Monads
  Spec.NumInstance.NumInstance
  Spec.NumInstanceLiteral.NumInstanceLiteral