weeder 2.8.0 → 2.9.0
raw patch · 30 files changed
+281/−214 lines, 30 filesdep +Globdep +hspec-expectationsdep +tastydep −hspecdep ~containersdep ~directorydep ~filepath
Dependencies added: Glob, hspec-expectations, tasty, tasty-golden, tasty-hunit-compat
Dependencies removed: hspec
Dependency ranges changed: containers, directory, filepath, ghc, lens, optparse-applicative, text, transformers
Files
- CHANGELOG.md +14/−0
- README.md +7/−2
- src/Weeder.hs +39/−16
- src/Weeder/Config.hs +14/−5
- src/Weeder/Main.hs +21/−43
- src/Weeder/Run.hs +26/−10
- test/Main.hs +82/−0
- test/Spec.hs +0/−88
- test/Spec/ApplicativeDo.failing +2/−2
- test/Spec/BasicExample.stdout +1/−1
- test/Spec/ConfigInstanceModules.stdout +2/−2
- test/Spec/DeriveGeneric.stdout +1/−1
- test/Spec/InstanceTypeclass.stdout +2/−2
- test/Spec/ModuleRoot.stdout +2/−0
- test/Spec/ModuleRoot.toml +5/−0
- test/Spec/ModuleRoot/InstanceNotRoot.hs +10/−0
- test/Spec/ModuleRoot/M.hs +11/−0
- test/Spec/Monads.failing +3/−3
- test/Spec/NumInstanceLiteral.failing +1/−1
- test/Spec/OverloadedLabels.stdout +1/−1
- test/Spec/OverloadedLists.failing +1/−1
- test/Spec/OverloadedStrings.failing +1/−1
- test/Spec/RangeEnum.failing +1/−1
- test/Spec/RootClasses.stdout +1/−1
- test/Spec/StandaloneDeriving.stdout +1/−1
- test/Spec/Types.stdout +1/−1
- test/Spec/TypesUnused.stdout +4/−4
- test/UnitTests.hs +0/−1
- test/UnitTests/Weeder/ConfigSpec.hs +12/−12
- weeder.cabal +15/−14
CHANGELOG.md view
@@ -4,6 +4,20 @@ 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
README.md view
@@ -26,7 +26,7 @@ `cabal.project.local` file: ``` cabal-package *+program-options ghc-options: -fwrite-ide-info ``` @@ -53,6 +53,10 @@ stack build ``` +### Nix++See [`weeder-nix`](https://github.com/NorfairKing/weeder-nix) for `weeder <-> nixpkgs` integration.+ ## Calling Weeder To call Weeder, you first need to provide a configuration file, `weeder.toml`. Weeder uses@@ -91,7 +95,8 @@ | ---------------- | ------------------------------------ | --- | | 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 view
@@ -44,6 +44,7 @@ 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 )@@ -56,6 +57,7 @@ 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 +66,7 @@ , 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 )@@ -101,7 +103,7 @@ , isVarOcc , occNameString )-import GHC.Types.SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart, srcLocLine )+import GHC.Types.SrcLoc ( RealSrcSpan, realSrcSpanEnd, realSrcSpanStart, srcLocLine, srcLocCol ) -- lens import Control.Lens ( (%=) )@@ -157,7 +159,7 @@ Analysis { dependencyGraph :: Graph Declaration -- ^ A graph between declarations, capturing dependencies.- , declarationSites :: Map Declaration (Set Int)+ , declarationSites :: Map Declaration (Set (Int, Int)) -- ^ A partial mapping between declarations and their line numbers. -- This Map is partial as we don't always know where a Declaration was -- defined (e.g., it may come from a package without source code).@@ -270,7 +272,7 @@ 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,7 +280,9 @@ for_ hieASTs topLevelAnalysis + for_ hie_exports ( analyseExport hie_module ) + lookupType :: HieFile -> TypeIndex -> HieTypeFix lookupType hf t = recoverFullType t $ hie_types hf @@ -324,6 +328,15 @@ 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 =@@ -350,7 +363,9 @@ define :: MonadState Analysis m => Declaration -> RealSrcSpan -> m () define decl span = when ( realSrcSpanStart span /= realSrcSpanEnd span ) do- #declarationSites %= Map.insertWith Set.union decl ( Set.singleton . srcLocLine $ realSrcSpanStart span )+ let start = realSrcSpanStart span+ let loc = (srcLocLine start, srcLocCol start)+ #declarationSites %= Map.insertWith Set.union decl ( Set.singleton loc) #dependencyGraph %= overlay ( vertex decl ) @@ -716,22 +731,30 @@ } --- | 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) }
src/Weeder/Config.hs view
@@ -69,7 +69,9 @@ , 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 @@ , typeClassRoots = False , rootInstances = [ ClassOnly "\\.IsString$", ClassOnly "\\.IsList$" ] , unusedTypes = False+ , rootModules = mempty } @@ -115,6 +118,7 @@ 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 @@ 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 @@ 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 @@ , "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/Main.hs view
@@ -1,4 +1,5 @@ {-# language ApplicativeDo #-}+{-# language ScopedTypeVariables #-} {-# language BlockArguments #-} {-# language FlexibleContexts #-} {-# language NamedFieldPuns #-}@@ -14,11 +15,11 @@ 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,11 +29,14 @@ 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 ) import GHC.Iface.Ext.Types ( HieFile( hie_hs_file ), hieVersion )@@ -191,7 +195,7 @@ >>= mainWithConfig hieExt hieDirectories requireHsFiles where throwConfigError e =- throwIO $ ExitConfigFailure (show e)+ throwIO $ ExitConfigFailure (displayException e) decodeConfig noDefaultFields = if noDefaultFields@@ -234,17 +238,20 @@ -- 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 @@ -- | 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
src/Weeder/Run.hs view
@@ -19,10 +19,12 @@ 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)@@ -43,8 +45,10 @@ data Weed = Weed- { weedPath :: FilePath- , weedLoc :: Int+ { weedPackage :: String+ , weedPath :: FilePath+ , weedLine :: Int+ , weedCol :: Int , weedDeclaration :: Declaration , weedPrettyPrintedType :: Maybe String }@@ -52,7 +56,7 @@ formatWeed :: Weed -> String formatWeed Weed{..} =- weedPath <> ":" <> show weedLoc <> ": "+ weedPackage <> ": " <> weedPath <> ":" <> show weedLine <> ":" <> show weedCol <> ": " <> case weedPrettyPrintedType of Nothing -> occNameString ( declOccName weedDeclaration ) Just t -> "(Instance) :: " <> t@@ -62,7 +66,7 @@ -- 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 +100,19 @@ 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@@ -113,18 +125,22 @@ ( \d -> fold $ do moduleFilePath <- Map.lookup ( declModule d ) ( modulePaths analysis )+ let packageName = unitString . moduleUnit . declModule $ d starts <- Map.lookup d ( declarationSites analysis )+ let locs = (,) packageName <$> Set.toList starts guard $ not $ null starts- return [ Map.singleton moduleFilePath ( liftA2 (,) (Set.toList starts) (pure d) ) ]+ return [ Map.singleton moduleFilePath ( liftA2 (,) locs (pure d) ) ] ) dead weeds = Map.toList warnings & concatMap \( weedPath, declarations ) ->- sortOn fst declarations & map \( weedLoc, weedDeclaration ) ->+ sortOn fst declarations & map \( (weedPackage, (weedLine, weedCol)) , weedDeclaration ) -> Weed { weedPrettyPrintedType = Map.lookup weedDeclaration (prettyPrintedType analysis)+ , weedPackage , weedPath- , weedLoc+ , weedLine+ , weedCol , weedDeclaration }
+ test/Main.hs view
@@ -0,0 +1,82 @@+module Main (main) where++import qualified Weeder.Main+import qualified Weeder.Run+import qualified Weeder+import qualified TOML+import qualified UnitTests.Weeder.ConfigSpec++import Data.Maybe+import Algebra.Graph.Export.Dot+import GHC.Types.Name.Occurrence (occNameString)+import System.Directory+import System.FilePath+import System.IO (stderr, hPrint)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Control.Exception ( throwIO, IOException, handle )+import Data.List (find, sortOn)+import qualified Data.ByteString.Lazy as LBS+import Data.Text (pack)+import Data.Text.Encoding (encodeUtf8)+import Test.Tasty.Golden++main :: IO ()+main = do+ testOutputFiles <- fmap sortTests discoverIntegrationTests+ let hieDirectories = map (dropExtension . snd) testOutputFiles+ defaultMain $ + testGroup "Weeder"+ [ testGroup "Weeder.Run" $+ [ testGroup "runWeeder" $+ zipWith (uncurry integrationTest) + testOutputFiles + hieDirectories+ ]+ , UnitTests.Weeder.ConfigSpec.tests + ]+ where+ -- Sort the output files such that the failing ones go last+ sortTests = sortOn (isJust . fst)++-- | Run weeder on @hieDirectory@, comparing the output to @stdoutFile@.+--+-- The directory containing @hieDirectory@ must also have a @.toml@ file+-- with the same name as @hieDirectory@.+--+-- If @failingFile@ is @Just@, it is used as the expected output instead of+-- @stdoutFile@, and a different failure message is printed if the output+-- matches @stdoutFile@.+integrationTest :: Maybe FilePath -> FilePath -> FilePath -> TestTree+integrationTest failingFile stdoutFile hieDirectory = do+ goldenVsString (integrationTestText ++ hieDirectory) (fromMaybe stdoutFile failingFile) $ + integrationTestOutput hieDirectory+ where+ integrationTestText = case failingFile of+ Nothing -> "produces the expected output for "+ Just _ -> "produces the expected (wrong) output for "++-- | Returns detected .failing and .stdout files in ./test/Spec+discoverIntegrationTests :: IO [(Maybe FilePath, FilePath)]+discoverIntegrationTests = do+ contents <- listDirectory testPath+ let stdoutFiles = map (testPath </>) $+ filter (".stdout" `isExtensionOf`) contents+ pure . map (\s -> (findFailing s contents, s)) $ stdoutFiles+ where+ findFailing s = fmap (testPath </>) . find (takeBaseName s <.> ".failing" ==)+ testPath = "./test/Spec"++-- | Run weeder on the given directory for .hie files, returning stdout+-- 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] False+ weederConfig <- TOML.decodeFile configExpr >>= either throwIO pure+ let (weeds, analysis) = Weeder.Run.runWeeder weederConfig hieFiles+ graph = Weeder.dependencyGraph analysis+ 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)+ where+ configExpr = hieDirectory <.> ".toml"
− test/Spec.hs
@@ -1,88 +0,0 @@-import qualified Weeder.Main-import qualified Weeder.Run-import qualified Weeder-import qualified TOML-import qualified UnitTests--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.Hspec-import Control.Monad (zipWithM_, when)-import Control.Exception ( throwIO, IOException, handle )-import Data.Maybe (isJust)-import Data.List (find, sortOn)--main :: IO ()-main = do- args <- getArgs- testOutputFiles <- fmap sortTests discoverIntegrationTests- let hieDirectories = map (dropExtension . snd) testOutputFiles- drawDots = mapM_ (drawDot . (<.> ".dot")) hieDirectories- graphviz = "--graphviz" `elem` args- withArgs (filter (/="--graphviz") args) $- hspec $ afterAll_ (when graphviz drawDots) $ do- describe "Weeder.Run" $- describe "runWeeder" $- zipWithM_ (uncurry integrationTestSpec) testOutputFiles hieDirectories- UnitTests.spec- where- -- Draw a dotfile via graphviz- drawDot f = callCommand $ "dot -Tpng " ++ f ++ " -o " ++ (f -<.> ".png")- -- Sort the output files such that the failing ones go last- sortTests = sortOn (isJust . fst)---- | Run weeder on @hieDirectory@, comparing the output to @stdoutFile@.------ The directory containing @hieDirectory@ must also have a @.toml@ file--- with the same name as @hieDirectory@.------ If @failingFile@ is @Just@, it is used as the expected output instead of--- @stdoutFile@, and a different failure message is printed if the output--- matches @stdoutFile@.-integrationTestSpec :: Maybe FilePath -> FilePath -> FilePath -> Spec-integrationTestSpec failingFile stdoutFile hieDirectory = do- it (integrationTestText ++ hieDirectory) $ do- expectedOutput <- readFile stdoutFile- actualOutput <- integrationTestOutput hieDirectory- case failingFile of- Just f -> do- failingOutput <- readFile f- actualOutput `shouldNotBe` expectedOutput- actualOutput `shouldBe` failingOutput- Nothing ->- actualOutput `shouldBe` expectedOutput- where- integrationTestText = case failingFile of- Nothing -> "produces the expected output for "- Just _ -> "produces the expected (wrong) output for "---- | Returns detected .failing and .stdout files in ./test/Spec-discoverIntegrationTests :: IO [(Maybe FilePath, FilePath)]-discoverIntegrationTests = do- contents <- listDirectory testPath- let stdoutFiles = map (testPath </>) $- filter (".stdout" `isExtensionOf`) contents- pure . map (\s -> (findFailing s contents, s)) $ stdoutFiles- where- findFailing s = fmap (testPath </>) . find (takeBaseName s <.> ".failing" ==)- testPath = "./test/Spec"---- | Run weeder on the given directory for .hie files, returning stdout--- Also creates a dotfile containing the dependency graph as seen by Weeder-integrationTestOutput :: FilePath -> IO String-integrationTestOutput hieDirectory = do- hieFiles <- Weeder.Main.getHieFiles ".hie" [hieDirectory] True- weederConfig <- TOML.decodeFile configExpr >>= either throwIO pure- let (weeds, analysis) = Weeder.Run.runWeeder weederConfig hieFiles- graph = Weeder.dependencyGraph analysis- graph' = export (defaultStyle (occNameString . Weeder.declOccName)) graph- handle (\e -> hPrint stderr (e :: IOException)) $- writeFile (hieDirectory <.> ".dot") graph'- pure (unlines $ map Weeder.Run.formatWeed weeds)- where- configExpr = hieDirectory <.> ".toml"
test/Spec/ApplicativeDo.failing view
@@ -1,2 +1,2 @@-test/Spec/ApplicativeDo/ApplicativeDo.hs:6: (Instance) :: Functor Foo-test/Spec/ApplicativeDo/ApplicativeDo.hs:9: (Instance) :: Applicative Foo+main: test/Spec/ApplicativeDo/ApplicativeDo.hs:6:1: (Instance) :: Functor Foo+main: test/Spec/ApplicativeDo/ApplicativeDo.hs:9:1: (Instance) :: Applicative Foo
test/Spec/BasicExample.stdout view
@@ -1,1 +1,1 @@-test/Spec/BasicExample/BasicExample.hs:4: unrelated+main: test/Spec/BasicExample/BasicExample.hs:4:1: unrelated
test/Spec/ConfigInstanceModules.stdout view
@@ -1,2 +1,2 @@-test/Spec/ConfigInstanceModules/Module1.hs:3: (Instance) :: Show T-test/Spec/ConfigInstanceModules/Module2.hs:3: (Instance) :: Bounded T+main: test/Spec/ConfigInstanceModules/Module1.hs:3:24: (Instance) :: Show T+main: test/Spec/ConfigInstanceModules/Module2.hs:3:30: (Instance) :: Bounded T
test/Spec/DeriveGeneric.stdout view
@@ -1,1 +1,1 @@-test/Spec/DeriveGeneric/DeriveGeneric.hs:12: (Instance) :: FromJSON T+main: test/Spec/DeriveGeneric/DeriveGeneric.hs:12:7: (Instance) :: FromJSON T
test/Spec/InstanceTypeclass.stdout view
@@ -1,2 +1,2 @@-test/Spec/InstanceTypeclass/InstanceTypeclass.hs:4: Foo-test/Spec/InstanceTypeclass/InstanceTypeclass.hs:10: (Instance) :: Foo Char+main: test/Spec/InstanceTypeclass/InstanceTypeclass.hs:4:1: Foo+main: test/Spec/InstanceTypeclass/InstanceTypeclass.hs:10:1: (Instance) :: Foo Char
+ test/Spec/ModuleRoot.stdout view
@@ -0,0 +1,2 @@+test/Spec/ModuleRoot/InstanceNotRoot.hs:9: (Instance) :: C T+test/Spec/ModuleRoot/M.hs:11: weed
+ test/Spec/ModuleRoot.toml view
@@ -0,0 +1,5 @@+roots = []++root-modules = [ '^Spec\.ModuleRoot\.M$', '^Spec\.ModuleRoot\.InstanceNotRoot$' ]++type-class-roots = false
+ test/Spec/ModuleRoot/InstanceNotRoot.hs view
@@ -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 view
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+module Spec.ModuleRoot.M (root) where++root :: ()+root = dependency++dependency :: ()+dependency = ()++weed :: ()+weed = ()
test/Spec/Monads.failing view
@@ -1,3 +1,3 @@-test/Spec/Monads/Monads.hs:20: (Instance) :: Functor Identity'-test/Spec/Monads/Monads.hs:23: (Instance) :: Applicative Identity'-test/Spec/Monads/Monads.hs:27: (Instance) :: Monad Identity'+main: test/Spec/Monads/Monads.hs:20:1: (Instance) :: Functor Identity'+main: test/Spec/Monads/Monads.hs:23:1: (Instance) :: Applicative Identity'+main: test/Spec/Monads/Monads.hs:27:1: (Instance) :: Monad Identity'
test/Spec/NumInstanceLiteral.failing view
@@ -1,1 +1,1 @@-test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs:7: (Instance) :: Num Modulo1+main: test/Spec/NumInstanceLiteral/NumInstanceLiteral.hs:7:1: (Instance) :: Num Modulo1
test/Spec/OverloadedLabels.stdout view
@@ -1,1 +1,1 @@-test/Spec/OverloadedLabels/OverloadedLabels.hs:17: (Instance) :: Has Point "y" Int+main: test/Spec/OverloadedLabels/OverloadedLabels.hs:17:1: (Instance) :: Has Point "y" Int
test/Spec/OverloadedLists.failing view
@@ -1,1 +1,1 @@-test/Spec/OverloadedLists/OverloadedLists.hs:9: (Instance) :: IsList (BetterList x)+main: test/Spec/OverloadedLists/OverloadedLists.hs:9:1: (Instance) :: IsList (BetterList x)
test/Spec/OverloadedStrings.failing view
@@ -1,1 +1,1 @@-test/Spec/OverloadedStrings/OverloadedStrings.hs:10: (Instance) :: IsString BetterString+main: test/Spec/OverloadedStrings/OverloadedStrings.hs:10:1: (Instance) :: IsString BetterString
test/Spec/RangeEnum.failing view
@@ -1,1 +1,1 @@-test/Spec/RangeEnum/RangeEnum.hs:14: (Instance) :: Enum Colour+main: test/Spec/RangeEnum/RangeEnum.hs:14:13: (Instance) :: Enum Colour
test/Spec/RootClasses.stdout view
@@ -1,1 +1,1 @@-test/Spec/RootClasses/RootClasses.hs:5: (Instance) :: Enum T+main: test/Spec/RootClasses/RootClasses.hs:5:34: (Instance) :: Enum T
test/Spec/StandaloneDeriving.stdout view
@@ -1,1 +1,1 @@-test/Spec/StandaloneDeriving/StandaloneDeriving.hs:6: (Instance) :: Show A+main: test/Spec/StandaloneDeriving/StandaloneDeriving.hs:6:1: (Instance) :: Show A
test/Spec/Types.stdout view
@@ -1,1 +1,1 @@-test/Spec/Types/Usages.hs:16: notRoot+main: test/Spec/Types/Usages.hs:16:1: notRoot
test/Spec/TypesUnused.stdout view
@@ -1,4 +1,4 @@-test/Spec/TypesUnused/TypesUnused.hs:6: Modulo1-test/Spec/TypesUnused/TypesUnused.hs:8: Number-test/Spec/TypesUnused/TypesUnused.hs:10: Vector-test/Spec/TypesUnused/TypesUnused.hs:12: Family+main: test/Spec/TypesUnused/TypesUnused.hs:6:1: Modulo1+main: test/Spec/TypesUnused/TypesUnused.hs:8:1: Number+main: test/Spec/TypesUnused/TypesUnused.hs:10:1: Vector+main: test/Spec/TypesUnused/TypesUnused.hs:12:1: Family
− test/UnitTests.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=UnitTests #-}
test/UnitTests/Weeder/ConfigSpec.hs view
@@ -1,25 +1,25 @@-module UnitTests.Weeder.ConfigSpec (spec) where+module UnitTests.Weeder.ConfigSpec (tests) where import Weeder.Config import qualified TOML import qualified Data.Text as T-import Test.Hspec (Spec, describe, it)+import Test.Tasty.HUnit+import Test.Hspec.Expectations (shouldBe)+import Test.Tasty (TestTree, testGroup) -spec :: Spec-spec = - describe "Weeder.Config" $- describe "configToToml" $- it "passes prop_configToToml" prop_configToToml+tests :: TestTree+tests = + testGroup "Weeder.Config"+ [ testCase "configToToml" configToTomlTests ] --- >>> prop_configToToml--- True-prop_configToToml :: Bool-prop_configToToml =+configToTomlTests :: Assertion+configToTomlTests = let cf = Config { rootPatterns = mempty , 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+ in TOML.decode cf' `shouldBe` Right cf
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.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@@ -31,7 +31,8 @@ , filepath ^>= 1.4.2.1 , generic-lens ^>= 2.2.0.0 , ghc ^>= 9.4 || ^>= 9.6 || ^>= 9.8- , lens ^>= 5.1 || ^>= 5.2+ , 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 , parallel ^>= 3.2.0.0@@ -52,17 +53,9 @@ ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded default-language: Haskell2010 - executable weeder build-depends: , base- , bytestring- , containers- , directory- , filepath- , ghc- , optparse-applicative- , transformers , weeder main-is: Main.hs hs-source-dirs: exe-weeder@@ -70,6 +63,8 @@ default-language: Haskell2010 test-suite weeder-test+ build-tool-depends:+ hspec-discover:hspec-discover build-depends: , aeson , algebraic-graphs@@ -78,19 +73,23 @@ , directory , filepath , ghc- , hspec , process+ , tasty+ , tasty-hunit-compat+ , tasty-golden , text , toml-reader , weeder+ , hspec-expectations+ , text+ , bytestring type: exitcode-stdio-1.0- main-is: Spec.hs+ main-is: Main.hs hs-source-dirs: test autogen-modules: Paths_weeder other-modules: Paths_weeder- UnitTests -- Tests Spec.ApplicativeDo.ApplicativeDo Spec.BasicExample.BasicExample@@ -100,6 +99,8 @@ Spec.DeriveGeneric.DeriveGeneric Spec.InstanceRootConstraint.InstanceRootConstraint Spec.InstanceTypeclass.InstanceTypeclass+ Spec.ModuleRoot.InstanceNotRoot+ Spec.ModuleRoot.M Spec.Monads.Monads Spec.NumInstance.NumInstance Spec.NumInstanceLiteral.NumInstanceLiteral