diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,11 @@ Changelog for Weeder +0.1.7 + #21, detect dependencies that are only required transitively + #13, respect the STACK_YAML environment variable + #20, add verbosity messages in a lot of places + #15, tone down unused import if exporting a cross-package type + #11, optimise execution speed (~3x faster) 0.1.6 #10, find files generated by alex/happy 0.1.5 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,18 +1,10 @@ # Weeder [![Hackage version](https://img.shields.io/hackage/v/weeder.svg?label=Hackage)](https://hackage.haskell.org/package/weeder) [![Stackage version](https://www.stackage.org/package/weeder/badge/lts?label=Stackage)](https://www.stackage.org/package/weeder) [![Linux Build Status](https://img.shields.io/travis/ndmitchell/weeder.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/weeder) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/weeder.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/weeder) -The principle is to delete dead code (pulling up the weeds). To do that, run: - -* GHC with `-fwarn-unused-binds -fwarn-unused-imports`, which finds unused definitions and unused imports in a module. -* [HLint](https://github.com/ndmitchell/hlint#readme), looking for "Redundant extension" hints, which finds unused extensions. -* The `weeder` tool, which detects functions that are exported internally but not available from outside this package. It also detects redundancies and missing information in your `.cabal` file. - -## Running Weeder locally - -Weeder piggy-backs off files generated by [`stack`](https://www.haskellstack.org), so first obtain stack, then: +Most projects accumulate code over time. Weeder detects unused Haskell exports, allowing dead code to be removed (pulling up the weeds). Weeder piggy-backs off files generated by [`stack`](https://www.haskellstack.org), so first obtain stack, then: * Install `weeder` by running `stack install weeder --resolver=nightly`. * Ensure your project has a `stack.yaml` file. If you don't normally build with `stack` then run `stack init` to generate one. -* Run `weeder . --build`, which builds your project with `stack` and checks it for weeds. +* Run `weeder . --build`, which builds your project with `stack` and reports any weeds. ## What does Weeder detect? @@ -28,6 +20,13 @@ I recommend fixing the warnings relating to `other-modules` and files not being compiled first, as these may cause other warnings to disappear. +## What else should I use? + +Weeder detects dead exports, which can be deleted. To get the most code deleted from removing an export, use: + +* GHC with `-fwarn-unused-binds -fwarn-unused-imports`, which finds unused definitions and unused imports in a module. +* [HLint](https://github.com/ndmitchell/hlint#readme), looking for "Redundant extension" hints, which finds unused extensions. + ## Ignoring weeds If you want your package to be detected as "weed free", but it has some weeds you know about but don't consider important, you can add a `.weeder.yaml` file adjacent to the `stack.yaml` with a list of exclusions. To generate an initial list of exclusions run `weeder . --yaml > .weeder.yaml`. @@ -60,3 +59,17 @@ - ps: Invoke-Command ([Scriptblock]::Create((Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/weeder/master/misc/appveyor.ps1').Content)) -ArgumentList @('.') The arguments inside `@()` are passed to `weeder`, so add new arguments surrounded by `'`, space separated - e.g. `@('.' '--build')`. + +## What about Cabal users? + +Weeder requires the textual `.hi` file for each source file in the project. Stack generates that already, so it was easy to integrate in to. There's no reason that information couldn't be extracted by either passing flags to Cabal, or converting the `.hi` files afterwards. I welcome patches to do that integration. + +## What about false positives? + +Weeder strives to avoid incorrectly warning about something that is required, if you find such an instance please report it on [the issue tracker](https://github.com/ndmitchell/weeder/issues). Unfortunately there are some cases where there are still false positives, as GHC doesn't put enough information in the `.hi` files: + +**Data.Coerce** If you use `Data.Coerce.coerce` the constructors for the data type must be in scope, but if they aren't used anywhere other than automatically by `coerce` then Weeder will report unused imports. You can ignore such warnings by adding `- message: Unused import` to your `.weeder.yaml` file. + +**Declaration QuasiQuotes** If you use a declaration-level quasi-quote then weeder won't see the use of the quoting function, potentially leading to an unused import warning, and marking the quoting function as a weed. The only solution is to ignore the entries with a `.weeder.yaml` file. + +**Stack extra-deps** Packages marked extra-deps in your `stack.yaml` will be weeded, due to a bug in [`stack`](https://github.com/commercialhaskell/stack/issues/3258). The only solution is to ignore the packages with a `.weeder.yaml` file. diff --git a/src/Check.hs b/src/Check.hs --- a/src/Check.hs +++ b/src/Check.hs @@ -49,7 +49,7 @@ warnRedundantPackageDependency S{..} = [ Warning pkg [cabalSectionType] "Redundant build-depends entry" (Just p) Nothing Nothing | (CabalSection{..}, (x1,x2)) <- sections - , let usedPackages = Set.unions $ map (hiImportPackage . hi) $ x1 ++ x2 + , let usedPackages = Set.unions $ map (Set.map fst . hiImportPackageModule . hi) $ x1 ++ x2 , p <- Set.toList $ Set.fromList cabalPackages `Set.difference` usedPackages] @@ -78,7 +78,8 @@ hiImportModule mod `Set.difference` (Set.map identModule (hiImportIdent mod) `Set.union` hiImportOrphan mod) , Set.null $ hiImportIdent mod `Set.intersection` hiExportIdent imp -- reexporting for someone else - , Set.null $ Set.map snd (hiImportPackageModule mod) `Set.intersection` Set.map identModule (hiExportIdent imp) -- reexporting for another package + , Set.null $ Set.map snd (hiImportPackageModule mod) `Set.intersection` Set.map identModule (hiExportIdent imp) -- reexporting for another package + , Set.null $ Set.map identModule (Set.filter (isHaskellCtor . identName) $ hiExportIdent imp) `Set.difference` Set.insert (hiModuleName imp) (hiImportModule imp) -- reexport a type for another package, see #15 ] warnUnusedExport :: S -> [Warning] diff --git a/src/Hi.hs b/src/Hi.hs --- a/src/Hi.hs +++ b/src/Hi.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveGeneric, RecordWildCards, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric, RecordWildCards, GeneralizedNewtypeDeriving, OverloadedStrings #-} module Hi( HiKey(), Hi(..), Ident(..), @@ -7,23 +7,29 @@ import qualified Data.HashSet as Set import qualified Data.HashMap.Lazy as Map +import System.Console.CmdArgs.Verbosity import System.FilePath import System.Directory.Extra +import System.Time.Extra import GHC.Generics import Data.Tuple.Extra import Control.Monad +import Control.Exception +import Control.DeepSeq import Data.Char import Data.Hashable import Data.List.Extra import Data.Monoid import Data.Functor import Util +import qualified Str as S import System.IO.Extra import Prelude data Ident = Ident {identModule :: ModuleName, identName :: IdentName} deriving (Show,Eq,Ord,Generic) instance Hashable Ident +instance NFData Ident data Hi = Hi {hiModuleName :: ModuleName @@ -47,6 +53,7 @@ -- ^ Things that are field names } deriving (Show,Eq,Generic) instance Hashable Hi +instance NFData Hi instance Monoid Hi where mempty = Hi mempty mempty mempty mempty mempty mempty mempty mempty mempty @@ -68,14 +75,26 @@ hiParseDirectory :: FilePath -> IO (Map.HashMap FilePath HiKey, Map.HashMap HiKey Hi) hiParseDirectory dir = do + whenLoud $ putStrLn $ "Reading hi directory " ++ dir files <- filter ((==) ".dump-hi" . takeExtension) <$> listFilesRecursive dir his <- forM files $ \file -> do - src <- readFile' file - return (drop (length dir + 1) file, trimSignatures $ hiParseContents src) + let name = drop (length dir + 1) file + whenLoud $ do + putStr $ "Reading hi file " ++ name ++ " ... " + hFlush stdout + (time, (len, res)) <- duration $ do + src <- S.readFileUTF8 file + len <- evaluate $ S.length src + let res = trimSignatures $ hiParseContents src + evaluate $ rnf res + return (len, res) + whenLoud $ putStrLn $ S.showLength len ++ " bytes in " ++ showDuration time + return (name, res) -- here we try and dedupe any identical Hi modules let keys = Map.fromList $ map (second HiKey . swap) his - let mp1 = Map.fromList $ map (second (keys Map.!)) his - let mp2 = Map.fromList $ map swap $ Map.toList keys + mp1 <- evaluate $ Map.fromList $ map (second (keys Map.!)) his + mp2 <- evaluate $ Map.fromList $ map swap $ Map.toList keys + whenLoud $ putStrLn $ "Found " ++ show (Map.size mp1) ++ " files, " ++ show (Map.size mp2) ++ " distinct" return (mp1, mp2) -- note that in some cases we may get more/less internal signatures, so first remove them @@ -83,28 +102,29 @@ trimSignatures hi@Hi{..} = hi{hiSignatures = Map.filterWithKey (\k _ -> k `Set.member` names) hiSignatures} where names = Set.fromList [s | Ident m s <- Set.toList hiExportIdent, m == hiModuleName] -hiParseContents :: String -> Hi -hiParseContents = mconcat . map f . parseHanging . lines +hiParseContents :: Str -> Hi +hiParseContents = mconcat . map f . parseHanging2 . S.linesCR where f (x,xs) - | Just x <- stripPrefix "interface " x = mempty{hiModuleName = parseInterface x} - | Just x <- stripPrefix "exports:" x = mconcat $ map parseExports xs - | Just x <- stripPrefix "orphans:" x = mempty{hiImportOrphan = Set.fromList $ map parseInterface $ concatMap words $ x:xs} - | Just x <- stripPrefix "package dependencies:" x = mempty{hiImportPackage = Set.fromList $ map parsePackDep $ concatMap words $ x:xs} - | Just x <- stripPrefix "import " x = case xs of - [] | (pkg, mod) <- breakOn ":" $ words x !! 1 -> mempty - {hiImportPackageModule = Set.singleton (takeWhile (/= '@') pkg, drop 1 mod)} - xs -> let m = words x !! 1 in mempty + | Just x <- S.stripPrefix "interface " x = mempty{hiModuleName = parseInterface $ S.toList x} + | Just x <- S.stripPrefix "exports:" x = mconcat $ map (parseExports . S.toList) $ unindent2 xs + | Just x <- S.stripPrefix "orphans:" x = mempty{hiImportOrphan = Set.fromList $ map parseInterface $ concatMap (words . S.toList) $ x:xs} + | Just x <- S.stripPrefix "package dependencies:" x = mempty{hiImportPackage = Set.fromList $ map parsePackDep $ concatMap (words . S.toList) $ x:xs} + | Just x <- S.stripPrefix "import " x = case unindent2 xs of + [] | (pkg, mod) <- breakOn ":" $ words (S.toList x) !! 1 -> mempty + {hiImportPackageModule = Set.singleton (parsePackDep pkg, drop 1 mod)} + xs -> let m = words (S.toList x) !! 1 in mempty {hiImportModule = Set.singleton m - ,hiImportIdent = Set.fromList $ map (Ident m . fst . word1) $ dropWhile ("exports:" `isPrefixOf`) xs} - | length x == 32, all isHexDigit x, - (y,ys):_ <- parseHanging xs, - fun:"::":typ <- concatMap (wordsBy (`elem` ",()[]{} ")) $ y:ys, + ,hiImportIdent = Set.fromList $ map (Ident m . fst . word1 . S.toList) $ dropWhile ("exports:" `S.isPrefixOf`) xs} + | S.length x == S.ugly 32, S.all isHexDigit x, + (y,ys):_ <- parseHanging2 $ map (S.drop $ S.ugly 2) xs, + fun:"::":typ <- concatMap (wordsBy (`elem` (",()[]{} " :: String)) . S.toList) $ y:ys, not $ "$" `isPrefixOf` fun = mempty{hiSignatures = Map.singleton fun $ Set.fromList $ map parseIdent typ} | otherwise = mempty -- "old-locale-1.0.0.7@old-locale-1.0.0.7-KGBP1BSKxH5GCm0LnZP04j" -> "old-locale" + -- "old-locale-1.0.0.7" -> "old-locale" parsePackDep = intercalate "-" . takeWhile (any isAlpha) . wordsBy (== '-') . takeWhile (/= '@') -- "hlint-1.9.41-IPKy9tGF1918X9VRp9DMhp:HSE.All 8002" -> "HSE.All" @@ -118,7 +138,7 @@ ,hiFieldName = Set.fromList [Ident (identModule y) b | Ident "" b <- ys] ,hiSignatures = Map.fromList [(b, Set.singleton y) | Ident _ b <- ys, b /= identName y] } - where y:ys = map parseIdent $ wordsBy (`elem` "{} ") x + where y:ys = map parseIdent $ wordsBy (`elem` ("{} " :: String)) x -- "Language.Haskell.PPHsMode" -> Ident "Language.Haskell" "PPHsMode" parseIdent x diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -9,6 +9,7 @@ import Data.Functor import Data.Tuple.Extra import Control.Monad.Extra +import System.Console.CmdArgs.Verbosity import System.Exit import System.IO.Extra import qualified Data.HashMap.Strict as Map @@ -25,23 +26,29 @@ main :: IO () main = do cmd@Cmd{..} <- getCmd - res <- mapM (weedDirectory cmd) cmdProjects + res <- mapM (weedPath cmd) cmdProjects when (Bad `elem` res) exitFailure -weedDirectory :: Cmd -> FilePath -> IO Result -weedDirectory Cmd{..} dir = do - file <- do b <- doesDirectoryExist dir; return $ if b then dir "stack.yaml" else dir +weedPath :: Cmd -> FilePath -> IO Result +weedPath Cmd{..} proj = do + -- project may either be a directory name, or a stack.yaml file + file <- do + isDir <- doesDirectoryExist proj + if isDir then findStack proj else return proj + whenLoud $ putStrLn $ "Running on Stack file " ++ file when cmdBuild $ buildStack file Stack{..} <- parseStack cmdDistDir file cabals <- forM stackPackages $ \x -> do - file <- selectCabalFile $ dir x + file <- selectCabalFile x (file,) <$> parseCabal file ignore <- do let x = takeDirectory file ".weeder.yaml" b <- doesFileExist x - if not b then return [] else readWarningsFile x + if not b then return [] else do + whenLoud $ putStrLn $ "Reading ignored warnings from " ++ x + readWarningsFile x let quiet = cmdJson || cmdYaml res <- forM cabals $ \(cabalFile, Cabal{..}) -> do diff --git a/src/Stack.hs b/src/Stack.hs --- a/src/Stack.hs +++ b/src/Stack.hs @@ -1,14 +1,15 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards #-} -module Stack(Stack(..), parseStack, buildStack) where +module Stack(Stack(..), findStack, parseStack, buildStack) where import Data.Yaml import Data.List.Extra import Control.Exception +import System.Directory.Extra import qualified Data.Text as T import qualified Data.HashMap.Strict as Map import qualified Data.ByteString.Char8 as BS -import System.Process +import Util import Data.Functor import Prelude @@ -18,17 +19,21 @@ ,stackDistDir :: FilePath } +findStack :: FilePath -> IO String +findStack dir = withCurrentDirectory dir $ + fst . line1 <$> cmdStdout "stack" ["path","--config-location"] + buildStack :: FilePath -> IO () -buildStack file = callProcess "stack" ["build","--stack-yaml=" ++ file,"--test","--bench","--no-run-tests","--no-run-benchmarks"] +buildStack file = cmd "stack" ["build","--stack-yaml=" ++ file,"--test","--bench","--no-run-tests","--no-run-benchmarks"] -- | Note that in addition to parsing the stack.yaml file it also runs @stack@ to -- compute the dist-dir. parseStack :: Maybe FilePath -> FilePath -> IO Stack parseStack distDir file = do stackDistDir <- case distDir of - Nothing -> fst . line1 <$> readCreateProcess (proc "stack" ["path","--dist-dir","--stack-yaml=" ++ file]) "" + Nothing -> fst . line1 <$> cmdStdout "stack" ["path","--dist-dir","--stack-yaml=" ++ file] Just x -> return x - stackPackages <- f . decodeYaml <$> readCreateProcess (proc "stack" ["query","locals","--stack-yaml=" ++ file]) "" + stackPackages <- f . decodeYaml <$> cmdStdout "stack" ["query","locals","--stack-yaml=" ++ file] return Stack{..} where decodeYaml = either throw id . decodeEither' . BS.pack diff --git a/src/Str.hs b/src/Str.hs new file mode 100644 --- /dev/null +++ b/src/Str.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE ViewPatterns #-} + +module Str( + Str, + linesCR, stripPrefix, + readFileUTF8, + S.null, S.isPrefixOf, S.drop, S.span, S.length, S.toList, S.all, S.uncons, + ugly, showLength + ) where + +import qualified Foundation as S +import qualified Foundation.String as S +import qualified Foundation.IO as S +import qualified Foundation.Conduit as C +import qualified Foundation.Conduit.Textual as C +import Data.Tuple.Extra + + +type Str = S.String + +showLength :: S.CountOf a -> String +showLength (S.CountOf x) = show x + +stripPrefix :: Str -> Str -> Maybe Str +stripPrefix (S.toBytes S.UTF8 -> pre) (S.toBytes S.UTF8 -> x) = + if pre `S.isPrefixOf` x then Just $ S.fromBytesUnsafe $ S.drop (S.length pre) x else Nothing + +removeR :: Str -> Str +removeR s | Just (s, c) <- S.unsnoc s, c == '\r' = s + | otherwise = s + +linesCR :: Str -> [Str] +linesCR s = map removeR $ C.runConduitPure (C.yield s C..| C.lines C..| C.sinkList) + +ugly :: S.Integral a => Integer -> a +ugly = S.fromInteger + + +readFileUTF8 :: FilePath -> IO Str +readFileUTF8 = fmap (fst3 . S.fromBytes S.UTF8) . S.readFile . S.fromString diff --git a/src/Util.hs b/src/Util.hs --- a/src/Util.hs +++ b/src/Util.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE GADTs, OverloadedStrings #-} module Util( + Str, PackageName, ModuleName, IdentName, parseHanging, + parseHanging2, unindent2, (?:), + isHaskellCtor, isHaskellSymbol, reachable, - isPathsModule + isPathsModule, + cmd, cmdStdout ) where import Data.Char @@ -13,6 +18,10 @@ import Data.Hashable import Data.List.Extra import Data.Tuple.Extra +import System.Process +import System.Console.CmdArgs.Verbosity +import Str(Str) +import qualified Str as S import qualified Data.HashSet as Set import Prelude @@ -28,8 +37,11 @@ -- | Parse a hanging lines of lines. parseHanging :: [String] -> [(String, [String])] -parseHanging = repeatedly (\(x:xs) -> first (\a -> (x, unindent a)) $ span (\x -> null x || " " `isPrefixOf` x) xs) +parseHanging = repeatedly (\(x:xs) -> first (\a -> (x, unindent a)) $ span (maybe True ((== ' ') . fst) . uncons) xs) +parseHanging2 :: [Str] -> [(Str, [Str])] +parseHanging2 = repeatedly (\(x:xs) -> first (\a -> (x, a)) $ span (maybe True ((== ' ') . fst) . S.uncons) xs) + unindent :: [String] -> [String] unindent xs = map (drop n) xs where @@ -37,14 +49,25 @@ f x = let (a,b) = span isSpace x in if null b then top else length a top = 1000 +unindent2 :: [Str] -> [Str] +unindent2 xs = map (S.drop n) xs + where + n = minimum $ top : map f xs + f x = let (a,b) = S.span isSpace x in if S.null b then top else S.length a + top = S.ugly 1000 + -- | Is the character a member of possible Haskell symbol characters, -- according to the Haskell report. isHaskellSymbol :: Char -> Bool isHaskellSymbol x = - x `elem` "!#$%&*+./<=>?@\\^|-~" || - (isSymbol x && x `notElem` "\"'_(),;[]`{}") + x `elem` ("!#$%&*+./<=>?@\\^|-~" :: String) || + (isSymbol x && x `notElem` ("\"'_(),;[]`{}" :: String)) +isHaskellCtor :: IdentName -> Bool +isHaskellCtor [] = False +isHaskellCtor (x:xs) = isUpper x || x == ':' + -- | Given a list of mappings, and an initial set, find which items can be reached reachable :: (Eq k, Hashable k) => (k -> [k]) -> [k] -> Set.HashSet k reachable follow = f Set.empty @@ -57,3 +80,14 @@ -- | Is a given module name the specially generated cabal Paths_foo module isPathsModule :: ModuleName -> Bool isPathsModule = isPrefixOf "Paths_" + + +cmd :: FilePath -> [String] -> IO () +cmd exe args = do + whenLoud $ putStrLn $ "Running: " ++ showCommandForUser exe args + callProcess exe args + +cmdStdout :: FilePath -> [String] -> IO String +cmdStdout exe args = do + whenLoud $ putStrLn $ "Running: " ++ showCommandForUser exe args + readCreateProcess (proc exe args) "" diff --git a/weeder.cabal b/weeder.cabal --- a/weeder.cabal +++ b/weeder.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: weeder -version: 0.1.6 +version: 0.1.7 license: BSD3 license-file: LICENSE category: Development @@ -16,7 +16,7 @@ extra-doc-files: README.md CHANGES.txt -tested-with: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 +tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4 source-repository head type: git @@ -33,11 +33,14 @@ yaml, vector, hashable, + directory, + deepseq, filepath, cmdargs, aeson, yaml, bytestring, + foundation >= 0.0.10, process >= 1.2.3.0, extra other-modules: @@ -48,3 +51,4 @@ Check Warning CmdLine + Str