From 919f629cb5cd060af5c972b96bbd759ff65c26a4 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 10 Jun 2024 10:25:58 +0100 Subject: [PATCH 01/10] Use `program-options` instead of `package *` in README (#164) This means the option is only passed to local packages, which avoids rebuilding dependencies. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index b53ce47..a0be851 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ If you use Cabal, this is easily done by adding one line to your `cabal.project.local` file: ``` cabal -package * +program-options ghc-options: -fwrite-ide-info ``` From 26f0b93725da5e41c29fe5bdd7a3d49d54c20fec Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Mon, 10 Jun 2024 11:17:16 +0100 Subject: [PATCH 02/10] Don't use `requireHsFiles` when running tests (#167) This causes a directory listing of `./.` to be forced (to find all `.hs` files), which for my checkout is a huge search. We don't really need this check though, so for tests it can be turned off. For me, this brings test execution time all the way down to <0.1s --- test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Main.hs b/test/Main.hs index 17dca70..b9a20ed 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -75,7 +75,7 @@ discoverIntegrationTests = do -- Also creates a dotfile containing the dependency graph as seen by Weeder integrationTestOutput :: FilePath -> IO LBS.ByteString integrationTestOutput hieDirectory = do - hieFiles <- Weeder.Main.getHieFiles ".hie" [hieDirectory] True + hieFiles <- Weeder.Main.getHieFiles ".hie" [hieDirectory] False weederConfig <- TOML.decodeFile configExpr >>= either throwIO pure let (weeds, analysis) = Weeder.Run.runWeeder weederConfig hieFiles graph = Weeder.dependencyGraph analysis From 5f23719e44a2e0ba7d08e385d9768acec4ce206e Mon Sep 17 00:00:00 2001 From: ryndubei <114586905+ryndubei@users.noreply.github.com> Date: Mon, 10 Jun 2024 12:30:04 +0000 Subject: [PATCH 03/10] Add root-modules field (#157) --- README.md | 3 ++- src/Weeder.hs | 16 ++++++++++++++-- src/Weeder/Config.hs | 19 ++++++++++++++----- src/Weeder/Run.hs | 16 ++++++++++++---- test/Spec/ModuleRoot.stdout | 2 ++ test/Spec/ModuleRoot.toml | 5 +++++ test/Spec/ModuleRoot/InstanceNotRoot.hs | 10 ++++++++++ test/Spec/ModuleRoot/M.hs | 11 +++++++++++ test/UnitTests/Weeder/ConfigSpec.hs | 1 + weeder.cabal | 2 ++ 10 files changed, 73 insertions(+), 12 deletions(-) create mode 100644 test/Spec/ModuleRoot.stdout create mode 100644 test/Spec/ModuleRoot.toml create mode 100644 test/Spec/ModuleRoot/InstanceNotRoot.hs create mode 100644 test/Spec/ModuleRoot/M.hs diff --git a/README.md b/README.md index a0be851..717854b 100644 --- a/README.md +++ b/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 diff --git a/src/Weeder.hs b/src/Weeder.hs index 8de39aa..f3b78ed 100644 --- a/src/Weeder.hs +++ b/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,7 +271,7 @@ 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 @@ -278,6 +279,8 @@ analyseHieFile' = do 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 = diff --git a/src/Weeder/Config.hs b/src/Weeder/Config.hs index 22a8b68..321fd74 100644 --- a/src/Weeder/Config.hs +++ b/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 diff --git a/src/Weeder/Run.hs b/src/Weeder/Run.hs index c4bf594..49abc70 100644 --- a/src/Weeder/Run.hs +++ b/src/Weeder/Run.hs @@ -19,12 +19,12 @@ import qualified Data.Set as Set import qualified Data.Map.Strict as Map -- ghc -import GHC.Plugins +import GHC.Plugins ( occNameString , unitString , moduleUnit , moduleName - , moduleNameString + , moduleNameString ) import GHC.Iface.Ext.Types ( HieFile( hie_asts ), getAsts ) import GHC.Iface.Ext.Utils (generateReferencesMap) @@ -66,7 +66,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 @@ -100,11 +100,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 diff --git a/test/Spec/ModuleRoot.stdout b/test/Spec/ModuleRoot.stdout new file mode 100644 index 0000000..911cd20 --- /dev/null +++ b/test/Spec/ModuleRoot.stdout @@ -0,0 +1,2 @@ +test/Spec/ModuleRoot/InstanceNotRoot.hs:9: (Instance) :: C T +test/Spec/ModuleRoot/M.hs:11: weed diff --git a/test/Spec/ModuleRoot.toml b/test/Spec/ModuleRoot.toml new file mode 100644 index 0000000..e3baaf4 --- /dev/null +++ b/test/Spec/ModuleRoot.toml @@ -0,0 +1,5 @@ +roots = [] + +root-modules = [ '^Spec\.ModuleRoot\.M$', '^Spec\.ModuleRoot\.InstanceNotRoot$' ] + +type-class-roots = false diff --git a/test/Spec/ModuleRoot/InstanceNotRoot.hs b/test/Spec/ModuleRoot/InstanceNotRoot.hs new file mode 100644 index 0000000..3023b3a --- /dev/null +++ b/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 diff --git a/test/Spec/ModuleRoot/M.hs b/test/Spec/ModuleRoot/M.hs new file mode 100644 index 0000000..83ae965 --- /dev/null +++ b/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 = () diff --git a/test/UnitTests/Weeder/ConfigSpec.hs b/test/UnitTests/Weeder/ConfigSpec.hs index adfdb43..7ee6e4a 100644 --- a/test/UnitTests/Weeder/ConfigSpec.hs +++ b/test/UnitTests/Weeder/ConfigSpec.hs @@ -19,6 +19,7 @@ configToTomlTests = , 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' `shouldBe` Right cf diff --git a/weeder.cabal b/weeder.cabal index 3dbaee2..5b5f2c5 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -98,6 +98,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 From 5c34e70fbd40ea403fbf28800787962386bc0a0c Mon Sep 17 00:00:00 2001 From: Pranay Sashank Date: Sat, 10 Aug 2024 18:53:03 +0530 Subject: [PATCH 04/10] Improve performance of weeder when type-class-roots = false is set. (#172) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit For analysing evidence uses we collect evidence uses in, ```haskell requestedEvidence :: Map Declaration (Set Name) ``` In analyseEvidenceUses, we loop over all the names in all the sets of the map, to construct dependency graph after calling `getEvidenceTree` on the name. However, these names in sets across different declarations are duplicated a lot. In one example in a repo at work, we have 16961625 names in which only 200330 are unique. So now, we instead pre-construct an evidence trees map `Map Name [Declaration]` for all the unique name and perform a lookup in this map to construct the graph. In a private repo, the times before this change and after ``` ❯ find . -name '*.hie' | wc -l 1097 ❯ time result/bin/weeder # weeder from master real 5m53.707s user 5m50.350s sys 0m2.206s ❯ time result/bin/weeder # weeder from this branch real 0m34.008s user 0m31.716s sys 0m2.196s ``` --- src/Weeder.hs | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/src/Weeder.hs b/src/Weeder.hs index f3b78ed..362264a 100644 --- a/src/Weeder.hs +++ b/src/Weeder.hs @@ -44,6 +44,7 @@ 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 ) @@ -730,22 +731,30 @@ requestEvidence n d = do } --- | Follow the given evidence uses back to their instance bindings, --- and connect the declaration to those bindings. -followEvidenceUses :: RefMap TypeIndex -> Declaration -> Set Name -> Graph Declaration -followEvidenceUses refMap d names = - let getEvidenceTrees = mapMaybe (getEvidenceTree refMap) . Set.toList - evidenceInfos = concatMap Tree.flatten (getEvidenceTrees names) +-- | 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 - evBindSiteDecls = mapMaybe (nameToDeclaration . evidenceVar) instanceEvidenceInfos - in star d evBindSiteDecls + in mapMaybe (nameToDeclaration . evidenceVar) instanceEvidenceInfos --- | Follow evidence uses listed under 'requestedEvidence' back to their +-- | 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 } = - let graphs = map (uncurry (followEvidenceUses rf)) $ Map.toList requestedEvidence +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))) + (Map.toList requestedEvidence) in a { dependencyGraph = overlays (dependencyGraph : graphs) } From 1cb230b1a91ff51c0afc3ba67df3471b963568d4 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sat, 10 Aug 2024 14:34:13 +0100 Subject: [PATCH 05/10] Build with lens-5.3 (#173) --- weeder.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/weeder.cabal b/weeder.cabal index 5b5f2c5..8fec794 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -31,7 +31,7 @@ library , filepath ^>= 1.4.2.1 , generic-lens ^>= 2.2.0.0 , ghc ^>= 9.4 || ^>= 9.6 || ^>= 9.8 - , lens ^>= 5.1 || ^>= 5.2 + , lens ^>= 5.1 || ^>= 5.2 || ^>= 5.3 , 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 , parallel ^>= 3.2.0.0 From 7ba2aa4833ed31ea4a5c3cc7d77a01f878d747a2 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Sat, 10 Aug 2024 15:38:37 +0200 Subject: [PATCH 06/10] Re-implement getFilesIn (#165) --- src/Weeder/Main.hs | 62 +++++++++++++++------------------------------- test/Main.hs | 7 +----- weeder.cabal | 1 + 3 files changed, 22 insertions(+), 48 deletions(-) diff --git a/src/Weeder/Main.hs b/src/Weeder/Main.hs index 5521cd6..cd103fb 100644 --- a/src/Weeder/Main.hs +++ b/src/Weeder/Main.hs @@ -1,4 +1,5 @@ {-# language ApplicativeDo #-} +{-# language ScopedTypeVariables #-} {-# language BlockArguments #-} {-# language FlexibleContexts #-} {-# language NamedFieldPuns #-} @@ -14,11 +15,11 @@ module Weeder.Main ( main, mainWithConfig, getHieFiles ) where import Control.Concurrent.Async ( async, link, ExceptionInLinkedThread ( ExceptionInLinkedThread ) ) -- base -import Control.Exception ( Exception, throwIO, displayException, catches, Handler ( Handler ), SomeException ( SomeException ) ) +import Control.Exception ( Exception, throwIO, displayException, catches, Handler ( Handler ), SomeException ( SomeException )) import Control.Concurrent ( getChanContents, newChan, writeChan, setNumCapabilities ) +import Data.List import Control.Monad ( unless, when ) import Data.Foldable -import Data.List ( isSuffixOf ) import Data.Maybe ( isJust, catMaybes ) import Data.Version ( showVersion ) import System.Exit ( ExitCode(..), exitWith ) @@ -28,10 +29,13 @@ import System.IO ( stderr, hPutStrLn ) import qualified TOML -- directory -import System.Directory ( canonicalizePath, doesDirectoryExist, doesFileExist, doesPathExist, listDirectory, withCurrentDirectory ) +import System.Directory ( doesFileExist ) -- filepath -import System.FilePath ( isExtensionOf ) +import System.FilePath ( isExtSeparator ) + +-- glob +import qualified System.FilePath.Glob as Glob -- ghc import GHC.Iface.Ext.Binary ( HieFileResult( HieFileResult, hie_file_result ), readHieFileWithVersion ) @@ -234,17 +238,20 @@ mainWithConfig hieExt hieDirectories requireHsFiles weederConfig = handleWeederE -- Will rethrow exceptions as 'ExceptionInLinkedThread' to the calling thread. getHieFiles :: String -> [FilePath] -> Bool -> IO [HieFile] getHieFiles hieExt hieDirectories requireHsFiles = do - hieFilePaths <- + let hiePat = "**/*." <> hieExtNoSep + hieExtNoSep = if isExtSeparator (head hieExt) then tail hieExt else hieExt + + hieFilePaths :: [FilePath] <- concat <$> - traverse ( getFilesIn hieExt ) + traverse ( getFilesIn hiePat ) ( if null hieDirectories then ["./."] else hieDirectories ) - hsFilePaths <- + hsFilePaths :: [FilePath] <- if requireHsFiles - then getFilesIn ".hs" "./." + then getFilesIn "**/*.hs" "./." else pure [] hieFileResultsChan <- newChan @@ -274,43 +281,14 @@ getHieFiles hieExt hieDirectories requireHsFiles = do -- | Recursively search for files with the given extension in given directory getFilesIn :: String - -- ^ Only files with this extension are considered + -- ^ Only files matching this pattern are considered. -> FilePath -- ^ Directory to look in -> IO [FilePath] -getFilesIn ext path = do - exists <- - doesPathExist path - - if exists - then do - isFile <- - doesFileExist path - - if isFile && ext `isExtensionOf` path - then do - path' <- - canonicalizePath path - - return [ path' ] - - else do - isDir <- - doesDirectoryExist path - - if isDir - then do - cnts <- - listDirectory path - - withCurrentDirectory path ( foldMap ( getFilesIn ext ) cnts ) - - else - return [] - - else - return [] - +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 diff --git a/test/Main.hs b/test/Main.hs index b9a20ed..0800bf1 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -10,18 +10,13 @@ import Data.Maybe import Algebra.Graph.Export.Dot import GHC.Types.Name.Occurrence (occNameString) import System.Directory -import System.Environment (getArgs, withArgs) import System.FilePath -import System.Process import System.IO (stderr, hPrint) import Test.Tasty (TestTree, defaultMain, testGroup) -import Control.Monad (zipWithM_, when) import Control.Exception ( throwIO, IOException, handle ) -import Data.Maybe (isJust) import Data.List (find, sortOn) -import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS -import Data.Text (Text, pack) +import Data.Text (pack) import Data.Text.Encoding (encodeUtf8) import Test.Tasty.Golden diff --git a/weeder.cabal b/weeder.cabal index 8fec794..d524bee 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -31,6 +31,7 @@ library , filepath ^>= 1.4.2.1 , generic-lens ^>= 2.2.0.0 , ghc ^>= 9.4 || ^>= 9.6 || ^>= 9.8 + , Glob ^>= 0.9 || ^>= 0.10 , lens ^>= 5.1 || ^>= 5.2 || ^>= 5.3 , 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 From fa9c7dc77b1732dad7283c7a5365767cdfc4e54b Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sat, 10 Aug 2024 14:59:16 +0100 Subject: [PATCH 07/10] Release 2.9.0 (#174) --- CHANGELOG.md | 14 ++++++++++++++ weeder.cabal | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6794053..6738285 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,20 @@ 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). +## 2.9.0 - 2024-01-31 + +### Changed + +* Sort weeds by line number and then by column. (#155) +* Show unit names in output. (#156) +* Significantly improve weeders performance when using `type-class-roots = false`. (#172) +* Use `Glob` to find `.hie` files. This can avoid an infinite loop with recursive symlinks. (#165) +* Build with `lens-5.3`. (#173) + +### Fixed + +* Weeder now correctly reports TOML parse errors. (#161) + ## 2.8.0 - 2024-01-31 ### Added diff --git a/weeder.cabal b/weeder.cabal index d524bee..b5c2db6 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -5,8 +5,8 @@ name: weeder author: Ollie Charles maintainer: Ollie Charles build-type: Simple -version: 2.8.0 -copyright: Neil Mitchell 2017-2020, Oliver Charles 2020-2023 +version: 2.9.0 +copyright: Neil Mitchell 2017-2020, Oliver Charles 2020-2024 synopsis: Detect dead code description: Find declarations. homepage: https://github.com/ocharles/weeder#readme From bd6084776f85c668200f81d0236a59c7c7a459f4 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sat, 10 Aug 2024 15:12:51 +0100 Subject: [PATCH 08/10] Correct CHANGELOG.md (#175) --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6738285..d3316df 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,7 @@ 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). -## 2.9.0 - 2024-01-31 +## 2.9.0 - 2024-08-10 ### Changed From 56028d0c80fe89d4f2ae25275aedb72714fec7da Mon Sep 17 00:00:00 2001 From: ryndubei <114586905+ryndubei@users.noreply.github.com> Date: Thu, 12 Sep 2024 12:48:14 +0000 Subject: [PATCH 09/10] Fix test failure for ModuleRoot (#179) --- test/Spec/ModuleRoot.stdout | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Spec/ModuleRoot.stdout b/test/Spec/ModuleRoot.stdout index 911cd20..47a06e5 100644 --- a/test/Spec/ModuleRoot.stdout +++ b/test/Spec/ModuleRoot.stdout @@ -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 From 801491c9aea50fabef609c461214505659e6aa3b Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Mon, 28 Oct 2024 16:44:36 +0000 Subject: [PATCH 10/10] Allow specifying rts options (#181) Most rts options are disable without -rtsopts --- weeder.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/weeder.cabal b/weeder.cabal index b5c2db6..bb6df42 100644 --- a/weeder.cabal +++ b/weeder.cabal @@ -59,7 +59,7 @@ executable weeder , 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