weeder 2.9.0 → 2.10.0
raw patch · 8 files changed
+166/−80 lines, 8 filesdep ~algebraic-graphsdep ~basedep ~bytestringnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: algebraic-graphs, base, bytestring, containers, filepath, generic-lens, ghc, lens, optparse-applicative, parallel, toml-reader
API changes (from Hackage documentation)
Files
- CHANGELOG.md +16/−3
- src/Weeder.hs +92/−30
- src/Weeder/Config.hs +5/−5
- src/Weeder/Main.hs +14/−9
- src/Weeder/Run.hs +19/−19
- test/Main.hs +3/−1
- test/Spec/ModuleRoot.stdout +2/−2
- weeder.cabal +15/−11
CHANGELOG.md view
@@ -1,10 +1,23 @@ # Changelog All notable changes to this project will be documented in this file. -The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),-and is generated by [Changie](https://github.com/miniscruff/changie).+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). -## 2.9.0 - 2024-01-31+## 2.10.0 - 2025-07-29++### Added+* Support GHC-9.10 (#183, #194, #195)+* Support GHC-9.12 (#191)++### Changed+* Improve performance by caching EvidenceInfo (#188)+* Allow specifying rts options. (#181)++### Fixed +* Correct `CHANGELOG.md`. (#175)+* Fix ModuleRoot test failure. (#179)++## 2.9.0 - 2024-08-10 ### Changed
src/Weeder.hs view
@@ -9,6 +9,7 @@ {-# language OverloadedLabels #-} {-# language OverloadedStrings #-} {-# language TupleSections #-}+{-# language ViewPatterns #-} module Weeder ( -- * Analysis@@ -33,18 +34,16 @@ -- base import Control.Applicative ( Alternative )-import Control.Monad ( guard, msum, when, unless, mzero )+import Control.Monad ( guard, msum, when, unless, mzero, forM_, void ) import Data.Traversable ( for )-import Data.Maybe ( mapMaybe )+import Data.Maybe ( mapMaybe, isJust, fromJust ) import Data.Foldable ( for_, traverse_, toList )-import Data.Function ( (&) )-import Data.List ( intercalate )+import Data.List ( intercalate, find ) import Data.Monoid ( First( First ), getFirst ) import GHC.Generics ( Generic ) import Prelude hiding ( span ) -- containers-import Data.Containers.ListUtils ( nubOrd ) import Data.Map.Strict ( Map ) import qualified Data.Map.Strict as Map import Data.Sequence ( Seq )@@ -63,7 +62,7 @@ ( BindType( RegularBind ) , ContextInfo( Decl, ValBind, PatternBind, Use, TyDecl, ClassTyDecl, EvidenceVarBind, RecField ) , DeclType( DataDec, ClassDec, ConDec, SynDec, FamDec )- , EvVarSource ( EvInstBind, cls )+ , EvVarSource ( EvInstBind, cls, EvLetBind ) , HieAST( Node, nodeChildren, nodeSpan, sourcedNodeInfo ) , HieASTs( HieASTs ) , HieFile( HieFile, hie_asts, hie_exports, hie_module, hie_hs_file, hie_types )@@ -77,12 +76,13 @@ , RecFieldContext ( RecFieldOcc ) , TypeIndex , getSourcedNodeInfo+ , getEvBindDeps ) import GHC.Iface.Ext.Utils ( EvidenceInfo( EvidenceInfo, evidenceVar ) , RefMap+ , isEvidenceBind , findEvidenceUse- , getEvidenceTree , hieTypeToIface , recoverFullType )@@ -103,13 +103,16 @@ , isVarOcc , occNameString )+import GHC.Types.Unique.FM ( UniqFM, addToUFM_C, lookupUFM, elemUFM ) import GHC.Types.SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart, srcLocLine, srcLocCol )+import GHC.Utils.Monad (anyM) -- lens import Control.Lens ( (%=) ) -- mtl import Control.Monad.State.Class ( MonadState )+import Control.Monad.State.Strict ( State, modify', get, execState ) import Control.Monad.Reader.Class ( MonadReader, asks ) -- parallel@@ -168,8 +171,8 @@ -- from its definition. , implicitRoots :: Set Root -- ^ Stores information on Declarations that may be automatically marked- -- as always reachable. This is used, for example, to capture knowledge - -- not yet modelled in weeder, or to mark all instances of a class as + -- as always reachable. This is used, for example, to capture knowledge+ -- not yet modelled in weeder, or to mark all instances of a class as -- roots. , exports :: Map Module ( Set Declaration ) -- ^ All exports for a given module.@@ -190,7 +193,7 @@ instance Semigroup Analysis where- (<>) (Analysis a1 b1 c1 d1 e1 f1 g1) (Analysis a2 b2 c2 d2 e2 f2 g2)= + (<>) (Analysis a1 b1 c1 d1 e1 f1 g1) (Analysis a2 b2 c2 d2 e2 f2 g2)= Analysis (a1 `overlay` a2) (Map.unionWith (<>) b1 b2) (c1 <> c2) (Map.unionWith (<>) d1 d2) (e1 <> e2) (f1 <> f2) (Map.unionWith (<>) g1 g2) @@ -216,7 +219,7 @@ DeclarationRoot Declaration | -- | We store extra information for instances in order to be able -- to specify e.g. all instances of a class as roots.- InstanceRoot + InstanceRoot Declaration -- ^ Declaration of the instance Declaration -- ^ Declaration of the parent class | -- | All exported declarations in a module are roots.@@ -237,7 +240,6 @@ InstanceRoot d _ -> [ d ] -- filter InstanceRoots in `Main.hs` ModuleRoot m -> foldMap Set.toList ( Map.lookup m exports ) - -- | The set of all declarations that could possibly -- appear in the output. outputableDeclarations :: Analysis -> Set Declaration@@ -253,7 +255,7 @@ asts = Map.elems hieAsts decls = concatMap (toList . findIdentifiers' (const True)) asts in if unusedTypes- then stars do + then stars do (d, IdentifierDetails{identType}, _) <- decls t <- maybe mzero pure identType let ns = Set.toList $ typeToNames (lookupType hf t)@@ -274,7 +276,7 @@ analyseHieFile' = do 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 @@ -329,7 +331,7 @@ analyseExport :: MonadState Analysis m => Module -> AvailInfo -> m ()-analyseExport m a = +analyseExport m a = traverse_ (traverse_ addExport . nameToDeclaration) (availName a : availNames a) where @@ -432,7 +434,7 @@ guard $ annsContain n ("ClsInstD", "InstDecl") for_ ( findEvInstBinds n ) \(d, cs, ids, _) -> do- -- This makes instance declarations show up in + -- This makes instance declarations show up in -- the output if type-class-roots is set to False. define d nodeSpan @@ -482,7 +484,7 @@ when unusedTypes $ define dataTypeName (nodeSpan n) - -- Without connecting constructors to the data declaration TypeAliasGADT.hs + -- Without connecting constructors to the data declaration TypeAliasGADT.hs -- fails with a false positive for A conDecs <- for ( constructors n ) \constructor -> for ( foldMap ( First . Just ) ( findIdentifiers ( any isConDec ) constructor ) ) \conDec -> do@@ -732,29 +734,89 @@ -- | Follow the given evidence use back to their instance bindings-followEvidenceUses :: RefMap TypeIndex -> Name -> [Declaration]-followEvidenceUses rf name =- let evidenceInfos = maybe [] (nubOrd . Tree.flatten) (getEvidenceTree rf name)- -- Often, we get duplicates in the flattened evidence trees. Sometimes, it's- -- just one or two elements and other times there are 5x as many- instanceEvidenceInfos = evidenceInfos & filter \case- EvidenceInfo _ _ _ (Just (EvInstBind _ _, ModuleScope, _)) -> True- _ -> False- in mapMaybe (nameToDeclaration . evidenceVar) instanceEvidenceInfos+followEvidenceUses :: UniqFM Name (Set (EvidenceInfo TypeIndex)) -> Name -> Set Declaration+followEvidenceUses cachedEvidence name =+ let res = case lookupUFM cachedEvidence name of+ Just x -> x+ Nothing -> mempty + in Set.map fromJust+ $ Set.filter isJust+ $ Set.map (nameToDeclaration . evidenceVar)+ $ res +-- Adapted from GHC's getEvidenceTree+populateEvidenceTreeWith ::+ Ord a+ => RefMap a+ -> ((EvVarSource, Scope) -> Bool)+ -> Name+ -> State (UniqFM Name (Set (EvidenceInfo a))) ()+populateEvidenceTreeWith refmap evSrcFilter var = go [var]+ where+ go [] = pure ()+ go vars@(var:_) = do+ seenMap <- get+ if var `elemUFM` seenMap+ then do+ forM_ vars $ \v -> do+ -- we just checked that var exists, so fromJust is safe+ modify' (\m -> addToUFM_C mappend m v (fromJust $ lookupUFM m var))+ pure ()+ else do+ let mxs = Map.lookup (Right var) refmap+ case mxs of+ Just xs -> do+ case find (any isEvidenceBind . identInfo . snd) xs of+ Just (sp,dets) -> do+ let mtyp = identType dets+ case mtyp of+ Nothing -> pure ()+ Just typ -> do+ void $ flip anyM (Set.toList $ identInfo dets) $ \det -> do+ case det of+ EvidenceVarBind src@(EvLetBind (getEvBindDeps -> xs)) scp spn -> do+ forM_ vars $ \v -> do+ let evInfo = EvidenceInfo var sp typ (Just (src, scp, spn))+ modify' (\m -> addToUFM_C mappend m v (Set.singleton evInfo))+ mapM_ (\v -> go (v:vars)) xs+ pure True+ EvidenceVarBind src scp spn ->+ if evSrcFilter (src, scp)+ then do+ forM_ vars $ \v -> do+ let evInfo = EvidenceInfo var sp typ (Just (src,scp,spn))+ modify' (\m -> addToUFM_C mappend m v (Set.singleton evInfo))+ pure True+ else pure False+ _ -> pure False+ -- It is externally bound, we are not interested in them+ Nothing -> pure ()+ Nothing -> pure ()++ -- | Follow evidence uses listed under 'requestedEvidence' back to their -- instance bindings, and connect their corresponding declaration to those bindings. analyseEvidenceUses :: RefMap TypeIndex -> Analysis -> Analysis-analyseEvidenceUses rf a@Analysis{ requestedEvidence, dependencyGraph } = do+analyseEvidenceUses rf a@Analysis{ requestedEvidence, dependencyGraph } = do let combinedNames = mconcat (Map.elems requestedEvidence) -- We combine all the names in all sets into one set, because the names -- are duplicated a lot. In one example, the number of elements in the -- combined sizes of all the sets are 16961625 as opposed to the -- number of elements by combining all sets into one: 200330, that's an -- 80x difference!- declMap = Map.fromSet (followEvidenceUses rf) combinedNames- -- Map.! is safe because declMap contains all elements of v by definition- graphs = map (\(d, v) -> star d ((nubOrd $ foldMap (declMap Map.!) v)))++ ce = flip execState mempty $ forM_ (Set.toList combinedNames) $+ populateEvidenceTreeWith+ rf+ (\case+ (EvInstBind _ _, ModuleScope) -> True+ _ -> False)++ declMap = Map.fromSet (followEvidenceUses ce) combinedNames+ -- Map.! is safe because declMap contains all elements of v by definition++ graphs = map (\(d, v) -> star d ((Set.toList $ foldMap (declMap Map.!) v))) (Map.toList requestedEvidence)+ in a { dependencyGraph = overlays (dependencyGraph : graphs) }
src/Weeder/Config.hs view
@@ -50,7 +50,7 @@ type Config = ConfigType Regex --- | Configuration that has been parsed from TOML (and can still be +-- | Configuration that has been parsed from TOML (and can still be -- converted back), but not yet compiled to a 'Config'. type ConfigParsed = ConfigType String @@ -74,9 +74,9 @@ } deriving (Eq, Show, Functor, Foldable, Traversable) --- | Construct via InstanceOnly, ClassOnly or ModuleOnly, +-- | Construct via InstanceOnly, ClassOnly or ModuleOnly, -- and combine with the Semigroup instance. The Semigroup--- instance ignores duplicate fields, prioritising the +-- instance ignores duplicate fields, prioritising the -- left argument. data InstancePattern a = InstancePattern { instancePattern :: Maybe a@@ -116,7 +116,7 @@ tomlDecoder = do rootPatterns <- TOML.getFieldOr (rootPatterns defaultConfig) "roots" typeClassRoots <- TOML.getFieldOr (typeClassRoots defaultConfig) "type-class-roots"- rootInstances <- TOML.getFieldOr (rootInstances defaultConfig) "root-instances" + rootInstances <- TOML.getFieldOr (rootInstances defaultConfig) "root-instances" unusedTypes <- TOML.getFieldOr (unusedTypes defaultConfig) "unused-types" rootModules <- TOML.getFieldOr (rootModules defaultConfig) "root-modules" @@ -186,7 +186,7 @@ compileConfig :: ConfigParsed -> Either String Config-compileConfig conf@Config{ rootInstances, rootPatterns, rootModules } = +compileConfig conf@Config{ rootInstances, rootPatterns, rootModules } = traverse compileRegex conf' where rootInstances' = nubOrd rootInstances
src/Weeder/Main.hs view
@@ -41,6 +41,7 @@ import GHC.Iface.Ext.Binary ( HieFileResult( HieFileResult, hie_file_result ), readHieFileWithVersion ) import GHC.Iface.Ext.Types ( HieFile( hie_hs_file ), hieVersion ) import GHC.Types.Name.Cache ( initNameCache, NameCache )+import GHC.Builtin.Utils (knownKeyNames) -- optparse-applicative import Options.Applicative@@ -55,9 +56,9 @@ -- | Each exception corresponds to an exit code.-data WeederException +data WeederException = ExitNoHieFilesFailure- | ExitHieVersionFailure + | ExitHieVersionFailure FilePath -- ^ Path to HIE file Integer -- ^ HIE file's header version | ExitConfigFailure@@ -82,7 +83,7 @@ ExitWeedsFound -> mempty where - noHieFilesFoundMessage = + noHieFilesFoundMessage = "No HIE files found: check that the directory is correct " <> "and that the -fwrite-ide-info compilation flag is set." @@ -97,13 +98,13 @@ ] --- | Convert 'WeederException' to the corresponding 'ExitCode' and emit an error +-- | Convert 'WeederException' to the corresponding 'ExitCode' and emit an error -- message to stderr. -- -- Additionally, unwrap 'ExceptionInLinkedThread' exceptions: this is for -- 'getHieFiles'. handleWeederException :: IO a -> IO a-handleWeederException a = catches a handlers +handleWeederException a = catches a handlers where handlers = [ Handler rethrowExits , Handler unwrapLinks@@ -239,7 +240,10 @@ getHieFiles :: String -> [FilePath] -> Bool -> IO [HieFile] getHieFiles hieExt hieDirectories requireHsFiles = do let hiePat = "**/*." <> hieExtNoSep- hieExtNoSep = if isExtSeparator (head hieExt) then tail hieExt else hieExt+ hieExtNoSep = case uncons hieExt of+ Just (c0, hieExtNoSep')+ | isExtSeparator c0 -> hieExtNoSep'+ _ -> hieExt hieFilePaths :: [FilePath] <- concat <$>@@ -257,12 +261,13 @@ hieFileResultsChan <- newChan nameCache <-- initNameCache 'z' []+ -- See: https://gitlab.haskell.org/ghc/ghc/-/issues/26055+ initNameCache 'r' knownKeyNames a <- async $ handleWeederException do readHieFiles nameCache hieFilePaths hieFileResultsChan hsFilePaths writeChan hieFileResultsChan Nothing- + link a catMaybes . takeWhile isJust <$> getChanContents hieFileResultsChan@@ -288,7 +293,7 @@ getFilesIn pat root = do [result] <- Glob.globDir [Glob.compile pat] root pure result- + -- | Read a .hie file, exiting if it's an incompatible version. readCompatibleHieFileOrExit :: NameCache -> FilePath -> IO HieFile
src/Weeder/Run.hs view
@@ -67,7 +67,7 @@ -- 'formatWeed', and the final 'Analysis'. runWeeder :: Config -> [HieFile] -> ([Weed], Analysis) runWeeder weederConfig@Config{ rootPatterns, typeClassRoots, rootInstances, rootModules } hieFiles =- let + let asts = concatMap (Map.elems . getAsts . hie_asts) hieFiles rf = generateReferencesMap asts@@ -75,15 +75,15 @@ analyses = parMap rdeepseq (\hf -> execState (analyseHieFile weederConfig hf) emptyAnalysis) hieFiles - analyseEvidenceUses' = + analyseEvidenceUses' = if typeClassRoots then id else analyseEvidenceUses rf - analysis1 = - foldl' mappend mempty analyses+ analysis1 =+ Data.Foldable.foldl' mappend mempty analyses - -- Evaluating 'analysis1' first allows us to begin analysis + -- Evaluating 'analysis1' first allows us to begin analysis -- while hieFiles is still being read (since rf depends on all hie files) analysis = analysis1 `pseq` analyseEvidenceUses' analysis1@@ -100,18 +100,18 @@ rootPatterns ) ( outputableDeclarations analysis )- - matchingModules = - Set.filter - ((\s -> any (`matchTest` s) rootModules) . moduleNameString . moduleName) ++ matchingModules =+ Set.filter+ ((\s -> any (`matchTest` s) rootModules) . moduleNameString . moduleName) ( Map.keysSet $ exports analysis ) reachableSet = reachable analysis- ( Set.map DeclarationRoot roots - <> Set.map ModuleRoot matchingModules - <> 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,@@ -129,7 +129,7 @@ starts <- Map.lookup d ( declarationSites analysis ) let locs = (,) packageName <$> Set.toList starts guard $ not $ null starts- return [ Map.singleton moduleFilePath ( liftA2 (,) locs (pure d) ) ]+ return [ Map.singleton moduleFilePath ( Control.Applicative.liftA2 (,) locs (pure d) ) ] ) dead @@ -156,20 +156,20 @@ InstanceRoot d c -> typeClassRoots || matchingType where- matchingType = + matchingType = let mt = Map.lookup d prettyPrintedType matches = maybe (const False) (flip matchTest) mt in any (maybe True matches) filteredInstances - filteredInstances = - map instancePattern - . filter (maybe True (`matchTest` displayDeclaration c) . classPattern) - . filter (maybe True modulePathMatches . modulePattern) + filteredInstances =+ map instancePattern+ . filter (maybe True (`matchTest` displayDeclaration c) . classPattern)+ . filter (maybe True modulePathMatches . modulePattern) $ rootInstances modulePathMatches p = maybe False (p `matchTest`) (Map.lookup ( declModule d ) modulePaths) displayDeclaration :: Declaration -> String-displayDeclaration d = +displayDeclaration d = moduleNameString ( moduleName ( declModule d ) ) <> "." <> occNameString ( declOccName d )
test/Main.hs view
@@ -77,6 +77,8 @@ graph' = export (defaultStyle (occNameString . Weeder.declOccName)) graph handle (\e -> hPrint stderr (e :: IOException)) $ writeFile (hieDirectory <.> ".dot") graph'- pure (LBS.fromStrict $ encodeUtf8 $ pack $ unlines $ map Weeder.Run.formatWeed weeds)+ -- Normalize weedPackage. We get different values here based on our version of cabal-install/ghc.+ let weeds' = map (\weed -> weed {Weeder.Run.weedPackage = "main"}) weeds+ pure (LBS.fromStrict $ encodeUtf8 $ pack $ unlines $ map Weeder.Run.formatWeed weeds') where configExpr = hieDirectory <.> ".toml"
test/Spec/ModuleRoot.stdout view
@@ -1,2 +1,2 @@-test/Spec/ModuleRoot/InstanceNotRoot.hs:9: (Instance) :: C T-test/Spec/ModuleRoot/M.hs:11: weed+main: test/Spec/ModuleRoot/InstanceNotRoot.hs:9:1: (Instance) :: C T+main: test/Spec/ModuleRoot/M.hs:11:1: weed
weeder.cabal view
@@ -5,8 +5,8 @@ author: Ollie Charles <ollie@ocharles.org.uk> maintainer: Ollie Charles <ollie@ocharles.org.uk> build-type: Simple-version: 2.9.0-copyright: Neil Mitchell 2017-2020, Oliver Charles 2020-2024+version: 2.10.0+copyright: Neil Mitchell 2017-2020, Oliver Charles 2020-2025 synopsis: Detect dead code description: Find declarations. homepage: https://github.com/ocharles/weeder#readme@@ -20,25 +20,29 @@ test/Spec/*.stdout test/Spec/*.failing +source-repository head+ type: git+ location: https://github.com/ocharles/weeder.git+ library build-depends: , algebraic-graphs ^>= 0.7 , async ^>= 2.2.0- , base ^>= 4.17.0.0 || ^>= 4.18.0.0 || ^>= 4.19.0.0- , bytestring ^>= 0.10.9.0 || ^>= 0.11.0.0 || ^>= 0.12.0.2- , containers ^>= 0.6.2.1+ , base >= 4.17 && < 4.22+ , bytestring >= 0.10.9 && < 0.13+ , containers >= 0.6.2.1 && < 0.9 , directory ^>= 1.3.3.2- , filepath ^>= 1.4.2.1+ , filepath ^>= 1.4.2.1 || ^>= 1.5 , generic-lens ^>= 2.2.0.0- , ghc ^>= 9.4 || ^>= 9.6 || ^>= 9.8+ , ghc >= 9.4 && < 9.13 , Glob ^>= 0.9 || ^>= 0.10- , lens ^>= 5.1 || ^>= 5.2 || ^>= 5.3+ , lens >= 5.1 && < 5.4 , mtl ^>= 2.2.2 || ^>= 2.3- , optparse-applicative ^>= 0.14.3.0 || ^>= 0.15.1.0 || ^>= 0.16.0.0 || ^>= 0.17 || ^>= 0.18.1.0+ , optparse-applicative >= 0.14.3 && < 0.20 , parallel ^>= 3.2.0.0 , regex-tdfa ^>= 1.2.0.0 || ^>= 1.3.1.0 , text ^>= 2.0.1 || ^>= 2.1- , toml-reader ^>= 0.2.0.0+ , toml-reader >= 0.2.0.0 && < 0.3.1 , transformers ^>= 0.5.6.2 || ^>= 0.6 hs-source-dirs: src exposed-modules:@@ -59,7 +63,7 @@ , weeder main-is: Main.hs hs-source-dirs: exe-weeder- ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded -no-rtsopts-suggestions -with-rtsopts=-N+ ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded -no-rtsopts-suggestions -with-rtsopts=-N -rtsopts default-language: Haskell2010 test-suite weeder-test