├── .ghcid ├── Setup.hs ├── test ├── two │ ├── Setup.hs │ ├── app │ │ └── Main.hs │ ├── src │ │ ├── Impl.hs │ │ └── Common.hs │ ├── cli │ │ └── CLI.hs │ └── two.cabal ├── foo │ ├── src │ │ ├── Foo │ │ │ └── Used.hs │ │ ├── Dir │ │ │ ├── TypesOnly.hs │ │ │ ├── CoerceType.hs │ │ │ ├── Unused.hs │ │ │ ├── CoerceValue.hs │ │ │ ├── Orphan.hs │ │ │ ├── Reuse.hs │ │ │ ├── Reexport.hs │ │ │ ├── QuasiQuoter.hs │ │ │ ├── Library2.hs │ │ │ └── Everything.hs │ │ ├── Main.hs │ │ ├── Lexer.x │ │ └── Library1.hs │ └── foo.cabal ├── baz │ ├── src │ │ └── Main.hsc │ └── baz.cabal ├── bar │ ├── Main.hs │ ├── Internal.hs │ ├── Library.hs │ ├── Bar │ │ └── Bar.hs │ └── package.yaml ├── stack.yaml └── .weeder.yaml ├── misc ├── run.sh ├── travis.sh └── appveyor.ps1 ├── .gitignore ├── src ├── Paths.hs ├── Main.hs ├── Str.hs ├── CmdLine.hs ├── Stack.hs ├── Weeder.hs ├── Util.hs ├── Warning.hs ├── Cabal.hs ├── Check.hs └── Hi.hs ├── .ghci ├── travis.hs ├── .hlint.yaml ├── PULL_REQUEST_TEMPLATE.md ├── str ├── Str-String.hs ├── Str-Text.hs ├── go.bat ├── Str-ByteString.hs ├── Str-Foundation-Unsafe.hs └── Str-Foundation.hs ├── appveyor.yml ├── .travis.yml ├── LICENSE ├── weeder.cabal ├── CHANGES.txt └── README.md /.ghcid: -------------------------------------------------------------------------------- 1 | -c "ghci -ferror-spans -fno-code" -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/two/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test/foo/src/Foo/Used.hs: -------------------------------------------------------------------------------- 1 | 2 | module Foo.Used(used) where 3 | 4 | used = () 5 | -------------------------------------------------------------------------------- /test/foo/src/Dir/TypesOnly.hs: -------------------------------------------------------------------------------- 1 | 2 | module Dir.TypesOnly(Word8) where 3 | 4 | import Data.Word 5 | -------------------------------------------------------------------------------- /test/baz/src/Main.hsc: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = putStrLn "Hello, Haskell!" 5 | -------------------------------------------------------------------------------- /misc/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/run.sh | sh -s -- weeder $* 3 | -------------------------------------------------------------------------------- /test/foo/src/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | module Main(main) where 3 | 4 | import Library1 5 | 6 | main = exported `seq` print 1 7 | -------------------------------------------------------------------------------- /misc/travis.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/run.sh | sh -s -- weeder $* 3 | -------------------------------------------------------------------------------- /test/bar/Main.hs: -------------------------------------------------------------------------------- 1 | 2 | import Library 3 | import Internal 4 | 5 | main = print $ library + internalBoth + internalMain 6 | -------------------------------------------------------------------------------- /test/foo/src/Dir/CoerceType.hs: -------------------------------------------------------------------------------- 1 | module Dir.CoerceType(CoerceType(..)) where 2 | 3 | newtype CoerceType = CoerceType Int 4 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Unused.hs: -------------------------------------------------------------------------------- 1 | 2 | module Dir.Unused(unused) where 3 | 4 | import Dir.Everything 5 | 6 | unused = trim 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /.hpc/ 3 | .stack-work/ 4 | /issues/ 5 | stack.yaml 6 | 7 | # generated from package.yaml 8 | test/bar/bar.cabal 9 | -------------------------------------------------------------------------------- /test/foo/src/Dir/CoerceValue.hs: -------------------------------------------------------------------------------- 1 | module Dir.CoerceValue(coerceValue) where 2 | 3 | import Dir.CoerceType 4 | 5 | coerceValue = CoerceType 0 6 | -------------------------------------------------------------------------------- /src/Paths.hs: -------------------------------------------------------------------------------- 1 | 2 | module Paths_weeder(version) where 3 | 4 | import Data.Version.Extra 5 | 6 | version :: Version 7 | version = makeVersion [0,0] 8 | -------------------------------------------------------------------------------- /test/bar/Internal.hs: -------------------------------------------------------------------------------- 1 | 2 | module Internal where 3 | 4 | internalBoth = 1 5 | internalLibrary = 1 6 | internalMain = 1 7 | internalDirect = 1 8 | (*|*|*|*) = 1 9 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Orphan.hs: -------------------------------------------------------------------------------- 1 | 2 | module Dir.Orphan(bob) where 3 | 4 | import Dir.Everything 5 | 6 | instance Show Orphan where show _ = "" 7 | 8 | bob = "" 9 | -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | :set -fwarn-unused-binds -fwarn-unused-imports -fwarn-orphans 2 | :set -isrc 3 | :load src\Main.hs src\Paths.hs 4 | :def test const $ return ":main --test" 5 | -------------------------------------------------------------------------------- /test/bar/Library.hs: -------------------------------------------------------------------------------- 1 | 2 | module Library(library, internalDirect) where 3 | 4 | import Internal 5 | import Bar.Bar 6 | 7 | library = internalBoth + internalLibrary + bar 8 | -------------------------------------------------------------------------------- /test/foo/src/Lexer.x: -------------------------------------------------------------------------------- 1 | { 2 | module Lexer (lexer) where 3 | } 4 | %wrapper "basic" 5 | 6 | tokens :- 7 | $white+ ; 8 | 9 | { 10 | lexer = alexScanTokens 11 | } 12 | -------------------------------------------------------------------------------- /test/bar/Bar/Bar.hs: -------------------------------------------------------------------------------- 1 | 2 | -- test for https://github.com/ndmitchell/weeder/issues/42 3 | -- exe name the same as a library module prefix 4 | module Bar.Bar(bar) where 5 | 6 | bar = 1 7 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Reuse.hs: -------------------------------------------------------------------------------- 1 | 2 | module Dir.Reuse(reused) where 3 | 4 | import Dir.Reexport 5 | import Dir.TypesOnly 6 | import Foo.Used() 7 | 8 | reused = (0 :: Word8) `seq` Ctor1 1 1 9 | -------------------------------------------------------------------------------- /test/two/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Data.Text.IO as T 4 | import CLI (parseArgs) 5 | import Common 6 | 7 | main :: IO () 8 | main = T.putStrLn =<< fmap (helloMessage . hello) parseArgs 9 | -------------------------------------------------------------------------------- /misc/appveyor.ps1: -------------------------------------------------------------------------------- 1 | $Script = Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/neil/master/misc/appveyor.ps1' 2 | Invoke-Command ([Scriptblock]::Create($Script.Content)) -ArgumentList (@('weeder') + $args) 3 | -------------------------------------------------------------------------------- /test/bar/package.yaml: -------------------------------------------------------------------------------- 1 | name: bar 2 | dependencies: base 3 | 4 | library: 5 | exposed-modules: [Library] 6 | other-modules: [Internal,Bar.Bar] 7 | 8 | executables: 9 | bar: 10 | main: Main 11 | source-dirs: . 12 | -------------------------------------------------------------------------------- /travis.hs: -------------------------------------------------------------------------------- 1 | 2 | import System.Process.Extra 3 | 4 | main = do 5 | system_ "curl -sSL https://get.haskellstack.org/ | sh" 6 | system_ "stack init --resolver=nightly --ignore-subdirs --force" 7 | system_ "weeder --test --verbose +RTS -K1K" 8 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main(main) where 2 | 3 | import Weeder 4 | import System.Exit 5 | import System.Environment 6 | import Control.Monad 7 | 8 | main :: IO () 9 | main = do 10 | bad <- weeder =<< getArgs 11 | when (bad > 0) exitFailure 12 | -------------------------------------------------------------------------------- /test/two/src/Impl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Impl (helloMessage) where 4 | 5 | import Data.Semigroup ((<>)) 6 | import Data.Text (Text) 7 | 8 | helloMessage :: Text -> Text 9 | helloMessage w = "Hello, " <> w <> "!" 10 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Reexport.hs: -------------------------------------------------------------------------------- 1 | 2 | module Dir.Reexport(reexport1, reexport2, reexport3, module Dir.Everything) where 3 | 4 | import Dir.Everything 5 | import Dir.Orphan() 6 | 7 | reexport1 = usedFunction2 8 | reexport2 = show Orphan 9 | reexport3 = "" 10 | -------------------------------------------------------------------------------- /test/foo/src/Library1.hs: -------------------------------------------------------------------------------- 1 | 2 | module Library1(exported, D1(..), D2, d3, templateHaskell) where 3 | 4 | import Data.List.Extra 5 | import Dir.Everything 6 | import Dir.Reuse() 7 | import Foo.Used 8 | import Lexer 9 | 10 | exported _ = (lexer, chunksOf, used) 11 | -------------------------------------------------------------------------------- /test/foo/src/Dir/QuasiQuoter.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-missing-fields #-} 2 | 3 | module Dir.QuasiQuoter(quasi) where 4 | 5 | import Language.Haskell.TH.Quote 6 | 7 | {-# NOINLINE quasi #-} 8 | quasi :: QuasiQuoter 9 | quasi = QuasiQuoter {quoteDec = const $ return []} 10 | -------------------------------------------------------------------------------- /test/two/src/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | 3 | module Common (Sample(..), helloMessage) where 4 | 5 | import Data.Data (Data, Typeable) 6 | import Data.Text (Text) 7 | import Impl 8 | 9 | data Sample = Sample {hello :: Text} deriving (Show, Data, Typeable) 10 | -------------------------------------------------------------------------------- /test/two/cli/CLI.hs: -------------------------------------------------------------------------------- 1 | module CLI (parseArgs, sample) where 2 | 3 | import Common 4 | import System.Console.CmdArgs 5 | 6 | sample = Sample{hello = mempty &= help "World argument" &= opt "world"} 7 | &= summary "Sample v1" 8 | 9 | parseArgs :: IO Sample 10 | parseArgs = cmdArgs sample 11 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | # HLint configuration file 2 | # https://github.com/ndmitchell/hlint 3 | ########################## 4 | 5 | # This file contains a template configuration file, which is typically 6 | # placed as .hlint.yaml in the root of your project 7 | 8 | # Warnings currently triggered by your code 9 | - ignore: {name: "Use pure"} 10 | -------------------------------------------------------------------------------- /test/stack.yaml: -------------------------------------------------------------------------------- 1 | # Upgrade the resolver semi-regularly so that in Appveyor the "stack init" 2 | # and the below resolver can share at least the compiler 3 | resolver: nightly-2019-06-28 4 | packages: [foo, bar, baz, two] 5 | ghc-options: 6 | "$locals": -ddump-to-file -ddump-hi -Werror -Wunused-binds -Wunused-imports -Wno-missing-home-modules -optP-Wno-nonportable-include-path 7 | -------------------------------------------------------------------------------- /test/baz/baz.cabal: -------------------------------------------------------------------------------- 1 | name: baz 2 | version: 0.1.0.0 3 | license: PublicDomain 4 | build-type: Simple 5 | extra-source-files: ChangeLog.md 6 | cabal-version: >= 1.10 7 | 8 | executable baz 9 | main-is: Main.hs 10 | build-depends: base 11 | hs-source-dirs: src 12 | default-language: Haskell2010 13 | -------------------------------------------------------------------------------- /PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | Thanks for the pull request! 2 | 3 | By raising this pull request you confirm you are licensing your contribution under all licenses that apply to this project (see LICENSE) and that you have no patents covering your contribution. 4 | 5 | If you care, my PR preferences are at https://github.com/ndmitchell/neil#contributions, but they're all guidelines, and I'm not too fussy - you don't have to read them. 6 | -------------------------------------------------------------------------------- /str/Str-String.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, stripPrefix, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, toList, S.all, S.uncons, 7 | ugly, showLength 8 | ) where 9 | 10 | import Data.List.Extra as S 11 | import System.IO.Extra 12 | 13 | type Str = String 14 | 15 | toList = id 16 | showLength x = show x 17 | 18 | linesCR = lines 19 | 20 | ugly :: Integral a => Integer -> a 21 | ugly = fromInteger 22 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | build: off 2 | cache: "c:\\sr -> appveyor.yml" 3 | 4 | test_script: 5 | - set HLINT_ARGUMENTS=src 6 | - ps: Invoke-Expression (Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/neil/master/appveyor.ps1') 7 | - stack exec -- weeder . --verbose +RTS -K1K 8 | - stack exec -- weeder --test --verbose +RTS -K1K 9 | - ps: Invoke-Command ([Scriptblock]::Create((Invoke-WebRequest 'https://raw.githubusercontent.com/ndmitchell/weeder/master/misc/appveyor.ps1').Content)) -ArgumentList @('--version') 10 | -------------------------------------------------------------------------------- /str/Str-Text.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, S.stripPrefix, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, toList, S.all, S.uncons, 7 | ugly, showLength 8 | ) where 9 | 10 | import qualified Data.Text as S 11 | import qualified Data.Text.IO as S 12 | 13 | type Str = S.Text 14 | 15 | toList = S.unpack 16 | 17 | showLength x = show x 18 | 19 | linesCR = S.lines 20 | 21 | ugly :: Integral a => Integer -> a 22 | ugly = fromInteger 23 | 24 | readFileUTF8 = S.readFile 25 | -------------------------------------------------------------------------------- /str/go.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal 3 | cd %~dp0\.. 4 | 5 | for /r str %%i in (*.hs) do ( 6 | mkdir dist\str\%%~ni 7 | ghc --make src/Paths.hs %%i Main -isrc -outputdir dist\str\%%~ni -o dist\str\%%~ni\weeder || goto die 8 | dist\str\%%~ni\weeder --test || goto die 9 | ) 10 | for /r str %%i in (*.hs) do ( 11 | echo %%~ni 12 | for /L %%j in (1,1,5) do ( 13 | ptime dist\str\%%~ni\weeder %* | grep Execution 14 | ) 15 | ) 16 | 17 | exit /b 0 18 | 19 | :die 20 | exit /b 1 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Library2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module Dir.Library2(usedFunction1, reexport1, bob, MyClass3(..), myClass1, foo, (=~=), coerced) where 4 | 5 | import Dir.Reexport 6 | import Dir.QuasiQuoter 7 | import Data.Coerce 8 | import Dir.CoerceType 9 | import Dir.CoerceValue 10 | 11 | bob = reexport2 `seq` usedFunction1 12 | 13 | class MyClass1 a where myClass1 :: a 14 | class MyClass2 a where myClass2 :: a 15 | class MyClass3 a where myClass3 :: a 16 | 17 | foo _ = (myClass2, classWithFunc) 18 | 19 | [quasi| hello |] 20 | 21 | coerced = coerce coerceValue :: Int 22 | -------------------------------------------------------------------------------- /str/Str-ByteString.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, S.stripPrefix, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, toList, S.all, S.uncons, 7 | showLength, 8 | ugly 9 | ) where 10 | 11 | import qualified Data.ByteString.Char8 as S 12 | 13 | type Str = S.ByteString 14 | 15 | toList = S.unpack 16 | showLength x = show x 17 | 18 | removeR :: Str -> Str 19 | removeR s | Just (s, c) <- S.unsnoc s, c == '\r' = s 20 | | otherwise = s 21 | 22 | linesCR :: Str -> [Str] 23 | linesCR = map removeR . S.lines 24 | 25 | ugly :: Integral a => Integer -> a 26 | ugly = fromInteger 27 | 28 | readFileUTF8 = S.readFile 29 | -------------------------------------------------------------------------------- /test/two/two.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: two 3 | version: 0 4 | 5 | common same 6 | build-depends: base >=4.11 && <4.13, text 7 | default-language: Haskell2010 8 | 9 | library 10 | import: same 11 | exposed-modules: Common 12 | other-modules: Impl 13 | hs-source-dirs: src 14 | 15 | library cli 16 | import: same 17 | build-depends: two, cmdargs > 0.0, data-default 18 | exposed-modules: CLI 19 | hs-source-dirs: cli 20 | 21 | executable two 22 | import: same 23 | main-is: Main.hs 24 | hs-source-dirs: app 25 | build-depends: two, cli 26 | -------------------------------------------------------------------------------- /str/Str-Foundation-Unsafe.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, S.stripPrefix, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, S.toList, S.all, S.uncons, 7 | ugly, showLength 8 | ) where 9 | 10 | import qualified Foundation as S 11 | import qualified Foundation.String as S 12 | import qualified Foundation.IO as S 13 | import Data.Tuple.Extra 14 | 15 | 16 | type Str = S.String 17 | 18 | linesCR :: Str -> [Str] 19 | linesCR = S.lines 20 | 21 | ugly :: S.Integral a => Integer -> a 22 | ugly = S.fromInteger 23 | 24 | showLength x = show x 25 | 26 | readFileUTF8 :: FilePath -> IO Str 27 | readFileUTF8 = fmap S.fromBytesUnsafe . S.readFile . S.fromString 28 | -------------------------------------------------------------------------------- /str/Str-Foundation.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, S.stripPrefix, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, S.toList, S.all, S.uncons, 7 | ugly, showLength 8 | ) where 9 | 10 | import qualified Foundation as S 11 | import qualified Foundation.String as S 12 | import qualified Foundation.IO as S 13 | import Data.Tuple.Extra 14 | 15 | 16 | type Str = S.String 17 | 18 | linesCR :: Str -> [Str] 19 | linesCR = S.lines 20 | 21 | showLength x = show x 22 | 23 | ugly :: S.Integral a => Integer -> a 24 | ugly = S.fromInteger 25 | 26 | readFileUTF8 :: FilePath -> IO Str 27 | readFileUTF8 = fmap (fst3 . S.fromBytes S.UTF8) . S.readFile . S.fromString 28 | -------------------------------------------------------------------------------- /src/Str.hs: -------------------------------------------------------------------------------- 1 | 2 | module Str( 3 | Str, 4 | linesCR, 5 | readFileUTF8, 6 | S.null, S.isPrefixOf, S.drop, S.span, S.length, S.toList, S.all, S.uncons, S.stripPrefix, 7 | ugly, showLength 8 | ) where 9 | 10 | import qualified Foundation as S 11 | import qualified Foundation.String as S 12 | import qualified Foundation.IO as S 13 | import Data.Tuple.Extra 14 | 15 | 16 | type Str = S.String 17 | 18 | showLength :: S.CountOf a -> String 19 | showLength (S.CountOf x) = show x 20 | 21 | linesCR :: Str -> [Str] 22 | linesCR = S.lines 23 | 24 | ugly :: S.Integral a => Integer -> a 25 | ugly = S.fromInteger 26 | 27 | readFileUTF8 :: FilePath -> IO Str 28 | readFileUTF8 = fmap (fst3 . S.fromBytes S.UTF8) . S.readFile . S.fromString 29 | -------------------------------------------------------------------------------- /test/foo/foo.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 2.0 2 | build-type: Simple 3 | name: foo 4 | version: 0 5 | 6 | library 7 | default-language: Haskell2010 8 | hs-source-dirs: src 9 | build-depends: base ^>= 4.12, cmdargs > 0.0, process < 1000, extra -any, array (> 0) || (> 0.0 && < 10000), template-haskell 10 | build-tools: alex 11 | exposed-modules: 12 | Library1 13 | Dir.Library2 14 | other-modules: 15 | Lexer 16 | Dir.CoerceType 17 | Dir.CoerceValue 18 | Dir.Everything 19 | Dir.Orphan 20 | Dir.Reexport 21 | Dir.Unused 22 | Dir.TypesOnly 23 | Dir.QuasiQuoter 24 | Dir.Reuse 25 | 26 | executable foo 27 | default-language: Haskell2010 28 | build-depends: base, foo, process, array 29 | main-is: src/Main.hs 30 | -------------------------------------------------------------------------------- /test/foo/src/Dir/Everything.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Dir.Everything(module Data.List.Extra, module Dir.Everything) where 4 | 5 | import Data.List.Extra 6 | import Language.Haskell.TH.Syntax 7 | import System.Timeout 8 | 9 | usedFunction1 = undefined :: (T1 -> T1) -> () 10 | usedFunction2 = Other 11 | unusedFunction = 12 :: Int 12 | (=~=) a b = a == b -- used 13 | (==~==) a b = a == b 14 | 15 | class ClassWithFunc a where 16 | classWithFunc :: a 17 | 18 | data D1 = D1 {d1 :: Int} 19 | data D2 = D2 {d2 :: Int} 20 | data D3 = D3 {d3 :: Int} 21 | data D4 = D4 {d4 :: Int} 22 | data D5 = D5_ {d5 :: Int} 23 | data D6 = D6_ Int 24 | data D7 = D7 Int 25 | 26 | type T1 = D1 27 | type T2 = D2 28 | 29 | data Other = Other 30 | 31 | data Data 32 | = Ctor1 {field1 :: Int, field2 :: Int, field3 :: Int} 33 | | Ctor2 String 34 | 35 | type Type = Data 36 | 37 | data Orphan = Orphan 38 | 39 | templateHaskell :: Int 40 | templateHaskell = $(timeout `seq` lift (1 :: Int)) 41 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: minimal 2 | 3 | matrix: 4 | include: 5 | - env: GHCVER=8.0 6 | - env: GHCVER=8.2 7 | - env: GHCVER=8.4 8 | - env: GHCVER=8.6 9 | - env: GHCVER=8.8 10 | - env: GHCVER=8.10 11 | - env: GHCVER=head 12 | - os: osx 13 | 14 | script: 15 | - export HLINT_ARGUMENTS=src 16 | - curl -sSL https://raw.github.com/ndmitchell/neil/master/travis.sh | sh 17 | 18 | deploy: 19 | provider: releases 20 | api_key: 21 | secure: "dutV6WaRhnNPYyMe61/xG2W+OrG1hV3H6pZC6sqpz91ypNnnz+X5i+A4JJUZK9bvpTf9ThL3S3OdMjzuHGkkgO0dgvpjgM8+68RUW8s06TuITI7pOsqIT4T3dl/0hQvxgheCXxAujPMsmpscCPkTfgRnhcggSQmyp2tTra5K39iy9d7xc6azD8LtpRbZWyc4NHDFi2RrKZk16UAJ842E98yNL8JmsJKvm3R/OFvGmqclxQ37mlKsiOvmjNR5gJlfVCBvW4LvJ5ASQd4kgWkFIvw9XUtdpGvI6FsV/A5P25p+LcWRFuDiM6tVqFS3xRTiw4t3n+l/BNFL1pKDLCzU2aw0+cIVKkV5FiE2tYCAWZTb3q+5vS87M37Oi1u6V5ghAhcb7SAYdgH8emzkGC28YIMSUG0xajYXKEuFoILsxYiplf7gNMGrx1xXewf8w41lI1nKLri7s7xgNgwhU1+h8LeyU1PKr5cyb+aQK0d/XtN+gHusv22c6YXNEOOCfgTEWDsM+e3+B0KwjqfhN09LmZSa7ibXLLuXQfvZG4M56Qzh9GhLhjeH5gOftSSiKeIbD3lYTNJCNosnNwLPAAFnNSQvZq3CUu6ZtAf0b9HuijtKlz2X5c1223jkpCQiGAI/FjogSvnxnXzJBULmyB614FUramZTCi2rwJX+T4elbT8=" 22 | file_glob: true 23 | file: travis-release/* 24 | skip_cleanup: true 25 | on: 26 | tags: true 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Neil Mitchell 2017-2020. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Neil Mitchell nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /src/CmdLine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse -O0 #-} 3 | 4 | module CmdLine( 5 | Cmd(..), getCmd 6 | ) where 7 | 8 | import System.Console.CmdArgs.Implicit 9 | import Paths_weeder 10 | import Data.Version 11 | import Data.Functor 12 | import System.Environment 13 | import Prelude 14 | 15 | 16 | data Cmd = Cmd 17 | {cmdProjects :: [FilePath] 18 | ,cmdBuild :: Bool 19 | ,cmdTest :: Bool 20 | ,cmdMatch :: Bool 21 | ,cmdJson :: Bool 22 | ,cmdYaml :: Bool 23 | ,cmdShowAll :: Bool 24 | ,cmdDistDir :: Maybe String 25 | } deriving (Show, Data, Typeable) 26 | 27 | getCmd :: [String] -> IO Cmd 28 | getCmd args = withArgs args $ automatic <$> cmdArgsRun mode 29 | 30 | automatic :: Cmd -> Cmd 31 | automatic cmd 32 | | cmdTest cmd = cmd{cmdTest=False,cmdProjects=["test"],cmdBuild=True,cmdMatch=True} 33 | | null $ cmdProjects cmd = cmd{cmdProjects=["."]} 34 | | otherwise = cmd 35 | 36 | mode :: Mode (CmdArgs Cmd) 37 | mode = cmdArgsMode $ Cmd 38 | {cmdProjects = def &= args &= typ "DIR OR stack.yaml" 39 | ,cmdBuild = nam "build" &= help "Build the project first" 40 | ,cmdTest = nam "test" &= help "Run the test suite" 41 | ,cmdMatch = nam "match" &= help "Make the .weeder.yaml perfectly match" 42 | ,cmdJson = nam "json" &= help "Output JSON" 43 | ,cmdYaml = nam "yaml" &= help "Output YAML" 44 | ,cmdShowAll = nam "show-all" &= help "Show even ignored warnings" 45 | ,cmdDistDir = nam "dist-dir" &= typDir &= help "Stack dist-dir, defaults to 'stack path --dist-dir'" 46 | } &= explicit &= verbosity 47 | &= name "weeder" &= program "weeder" &= summary ("Weeder v" ++ showVersion version ++ ", (C) Neil Mitchell 2017-2020") 48 | where 49 | nam xs = def &= explicit &= name xs &= name [head xs] 50 | -------------------------------------------------------------------------------- /weeder.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.18 2 | build-type: Simple 3 | name: weeder 4 | version: 1.0.9 5 | license: BSD3 6 | license-file: LICENSE 7 | category: Development 8 | author: Neil Mitchell 9 | maintainer: Neil Mitchell 10 | copyright: Neil Mitchell 2017-2020 11 | synopsis: Detect dead code 12 | description: 13 | Find redundant package dependencies or redundant module exports. 14 | homepage: https://github.com/ndmitchell/weeder#readme 15 | bug-reports: https://github.com/ndmitchell/weeder/issues 16 | extra-doc-files: 17 | README.md 18 | CHANGES.txt 19 | tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 20 | 21 | source-repository head 22 | type: git 23 | location: https://github.com/ndmitchell/weeder.git 24 | 25 | library 26 | default-language: Haskell2010 27 | hs-source-dirs: src 28 | if impl(ghc < 8.0) 29 | build-depends: semigroups >= 0.18 30 | build-depends: 31 | base >= 4.6 && < 5, 32 | text, 33 | unordered-containers, 34 | yaml, 35 | vector, 36 | hashable, 37 | directory, 38 | deepseq, 39 | filepath, 40 | cmdargs, 41 | yaml >= 0.5.0, 42 | aeson >= 1.1.2.0, 43 | bytestring, 44 | foundation >= 0.0.13, 45 | process >= 1.2.3.0, 46 | extra >= 1.6.4 47 | exposed-modules: 48 | Weeder 49 | other-modules: 50 | Cabal 51 | Hi 52 | Stack 53 | Util 54 | Check 55 | Warning 56 | CmdLine 57 | Str 58 | Paths_weeder 59 | 60 | executable weeder 61 | default-language: Haskell2010 62 | main-is: src/Main.hs 63 | build-depends: 64 | base, 65 | weeder 66 | -------------------------------------------------------------------------------- /src/Stack.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} 2 | 3 | module Stack(Stack(..), findStack, parseStack, buildStack) where 4 | 5 | import Data.Yaml 6 | import Data.List.Extra 7 | import Control.Exception 8 | import Control.Monad.Extra 9 | import System.Directory.Extra 10 | import qualified Data.Text as T 11 | import qualified Data.HashMap.Strict as Map 12 | import qualified Data.ByteString.Char8 as BS 13 | import Util 14 | import Data.Functor 15 | import Prelude 16 | 17 | 18 | data Stack = Stack 19 | {stackPackages :: [FilePath] 20 | ,stackDistDir :: FilePath 21 | } 22 | 23 | findStack :: FilePath -> IO FilePath 24 | findStack dir = withCurrentDirectory dir $ do 25 | let args = ["path","--config-location","--color=never"] 26 | -- it may do a stack setup, so there may be lots of garbage and then the actual info at the end 27 | res <- maybe "" (trim . snd) . unsnoc . lines <$> cmdStdout "stack" args 28 | when (res == "") $ 29 | fail $ "Failed to find stack.yaml file\nCommand: " ++ unwords ("stack":args) 30 | return res 31 | 32 | buildStack :: FilePath -> IO () 33 | buildStack file = cmd "stack" ["build","--stack-yaml=" ++ file,"--test","--bench","--no-run-tests","--no-run-benchmarks","--color=never"] 34 | 35 | -- | Note that in addition to parsing the stack.yaml file it also runs @stack@ to 36 | -- compute the dist-dir. 37 | parseStack :: Maybe FilePath -> FilePath -> IO Stack 38 | parseStack distDir file = do 39 | stackDistDir <- case distDir of 40 | Nothing -> fst . line1 <$> cmdStdout "stack" ["path","--dist-dir","--stack-yaml=" ++ file,"--color=never"] 41 | Just x -> return x 42 | stackPackages <- f . decodeYaml <$> cmdStdout "stack" ["query","locals","--stack-yaml=" ++ file,"--color=never"] 43 | return Stack{..} 44 | where 45 | decodeYaml = either throw id . decodeEither' . BS.pack 46 | fromObject (Object x) = x 47 | fromString (String s) = T.unpack s 48 | f = map (fromString . (Map.! "path") . fromObject) . Map.elems . fromObject 49 | -------------------------------------------------------------------------------- /test/.weeder.yaml: -------------------------------------------------------------------------------- 1 | - package: 2 | - name: bar 3 | - section: 4 | - name: library exe:bar 5 | - message: 6 | - name: Module reused between components 7 | - module: 8 | - Internal 9 | - Library 10 | - Bar.Bar 11 | - message: 12 | - name: Weeds exported 13 | - module: 14 | - name: Internal 15 | - identifier: ! '*|*|*|*' 16 | - package: 17 | - name: foo 18 | - section: 19 | - name: exe:foo 20 | - message: 21 | - name: Redundant build-depends entry 22 | - depends: 23 | - array 24 | - process 25 | - section: 26 | - name: library 27 | - message: 28 | - name: Excessive other-modules entry 29 | - module: Dir.Unused 30 | - message: 31 | - name: Missing other-modules entry 32 | - module: Foo.Used 33 | - message: 34 | - name: Redundant build-depends entry 35 | - depends: 36 | - cmdargs 37 | - process 38 | - message: 39 | - name: Unused import 40 | - module: 41 | - name: Dir.Library2 42 | - identifier: 43 | - Dir.CoerceType 44 | - Dir.QuasiQuoter 45 | - module: 46 | - name: Library1 47 | - identifier: Dir.Reuse 48 | - message: 49 | - name: Weeds exported 50 | - module: 51 | - name: Dir.Everything 52 | - identifier: 53 | - ==~== 54 | - Ctor2 55 | - D4 56 | - D5 57 | - D5_ 58 | - D6 59 | - D6_ 60 | - D7 61 | - T2 62 | - Type 63 | - unusedFunction 64 | - usedFunction2 65 | - module: 66 | - name: Dir.Orphan 67 | - identifier: bob 68 | - module: 69 | - name: Dir.QuasiQuoter 70 | - identifier: quasi 71 | - module: 72 | - name: Dir.Reexport 73 | - identifier: reexport3 74 | - module: 75 | - name: Dir.Reuse 76 | - identifier: reused 77 | - module: 78 | - name: Dir.Unused 79 | - identifier: unused 80 | 81 | - package: 82 | - name: two 83 | - section: 84 | - name: exe:two 85 | - message: 86 | - name: Redundant build-depends entry 87 | - depends: cli 88 | - section: 89 | - name: library:cli 90 | - message: 91 | - name: Redundant build-depends entry 92 | - depends: 93 | - data-default 94 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | Changelog for Weeder 2 | 3 | 1.0.9, released 2020-06-11 4 | #55, fix handling of internal libraries 5 | 1.0.8, released 2018-08-26 6 | #42, make paths case-insensitive on MacOS 7 | 1.0.7, released 2018-08-23 8 | Don't warn on base as it is used by Paths_ modules 9 | #42, make --verbose print out the version number 10 | #41, make the --help output clear you can pass a stack.yaml 11 | 1.0.6, released 2018-06-16 12 | Don't fail with an error if stack setup is necessary 13 | If you fail to find stack.yaml give a better error message 14 | 1.0.5, released 2018-05-05 15 | #39, provide weeder as a library 16 | 1.0.4, released 2018-05-02 17 | #38, make sure you parse bracketed version ranges properly 18 | 1.0.3, released 2018-03-04 19 | #35, support ^>= operator in Cabal 20 | 1.0.2, released 2018-03-01 21 | Add lower bounds for Yaml and Aeson 22 | 1.0.1, released 2018-02-23 23 | #34, support -any for version numbers 24 | 1.0, released 2018-01-22 25 | #30, bump the version number to 1.0 26 | 0.1.13, released 2018-01-17 27 | #32, find .hi files in more places 28 | #32, always disable color when running stack 29 | 0.1.12, released 2018-01-16 30 | Make available on Mac 31 | 0.1.11, released 2017-12-29 32 | #29, deal with case-insensitive FilePath on Windows 33 | 0.1.10, released 2017-12-28 34 | Make --verbose print out the directory when running commands 35 | Don't report semigroups as unused on any platforms 36 | 0.1.9, released 2017-12-07 37 | Don't report Win32/unix as unused on the alternate platform 38 | 0.1.8, released 2017-12-06 39 | Follow both branches for if/else containing dependencies/modules 40 | 0.1.7, released 2017-08-09 41 | #21, detect dependencies that are only required transitively 42 | #13, respect the STACK_YAML environment variable 43 | #20, add verbosity messages in a lot of places 44 | #15, tone down unused import if exporting a cross-package type 45 | #11, optimise execution speed (~3x faster) 46 | 0.1.6, released 2017-06-18 47 | #10, find files generated by alex/happy 48 | 0.1.5, released 2017-06-02 49 | If --yaml and no hints give no output 50 | 0.1.4, released 2017-05-27 51 | #9, allow --dist-dir to set the stack dist-dir 52 | Deal with operators including | in them 53 | Allow arrays of arrays of strings in the .weeder.yaml 54 | 0.1.3, released 2017-05-08 55 | #5, document how to install weeder 56 | #8, detect unused imports, even import Foo() 57 | #7, don't say modules with only instances are always redundant 58 | #6, don't give partial pattern matches when reading .weeder.yaml 59 | 0.1.2, released 2017-04-29 60 | #3, deal with space-separated hs-source-dirs 61 | 0.1.1, released 2017-04-29 62 | #2, use "stack query" rather than parsing stack.yaml 63 | 0.1, released 2017-04-28 64 | Initial version 65 | -------------------------------------------------------------------------------- /src/Weeder.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables #-} 2 | 3 | -- | Run the @weeder@ program as a direct dependency. 4 | -- You are encouraged to use the binary in preference to the library. 5 | module Weeder(weeder) where 6 | 7 | import Hi 8 | import Cabal 9 | import Stack 10 | import Data.Version 11 | import Data.List.Extra 12 | import Data.Functor 13 | import Data.Tuple.Extra 14 | import Control.Monad.Extra 15 | import System.Console.CmdArgs.Verbosity 16 | import System.IO.Extra 17 | import qualified Data.HashMap.Strict as Map 18 | import System.Directory.Extra 19 | import System.FilePath 20 | import Paths_weeder 21 | import Check 22 | import Warning 23 | import CmdLine 24 | import Prelude 25 | 26 | 27 | -- | Given the weeder command line arguments, return the number of warnings that were produced. 28 | -- If the number is @0@ that corresponds to a successful run. 29 | weeder :: [String] -> IO Int 30 | weeder args = do 31 | cmd@Cmd{..} <- getCmd args 32 | whenLoud $ putStrLn $ "Weeder version " ++ showVersion version 33 | res <- mapM (weedPath cmd) cmdProjects 34 | return $ sum res 35 | 36 | 37 | weedPath :: Cmd -> FilePath -> IO Int 38 | weedPath Cmd{..} proj = do 39 | -- project may either be a directory name, or a stack.yaml file 40 | file <- do 41 | isDir <- doesDirectoryExist proj 42 | if isDir then findStack proj else return proj 43 | whenLoud $ putStrLn $ "Running on Stack file " ++ file 44 | when cmdBuild $ buildStack file 45 | Stack{..} <- parseStack cmdDistDir file 46 | cabals <- forM stackPackages $ \x -> do 47 | file <- selectCabalFile x 48 | (file,) <$> parseCabal file 49 | 50 | ignore <- do 51 | let x = takeDirectory file ".weeder.yaml" 52 | b <- doesFileExist x 53 | if not b then return [] else do 54 | whenLoud $ putStrLn $ "Reading ignored warnings from " ++ x 55 | readWarningsFile x 56 | let quiet = cmdJson || cmdYaml 57 | 58 | res <- forM cabals $ \(cabalFile, Cabal{..}) -> do 59 | (fileToKey, keyToHi) <- hiParseDirectory $ takeDirectory cabalFile stackDistDir 60 | let full = check (keyToHi Map.!) cabalName $ 61 | map (id &&& selectHiFiles stackDistDir fileToKey) cabalSections 62 | let warn = if cmdShowAll || cmdMatch then full else ignoreWarnings ignore full 63 | unless quiet $ 64 | putStrLn $ unlines $ showWarningsPretty cabalName warn 65 | return (length full - length warn, warn) 66 | let (ignored, warns) = sum *** concat $ unzip res 67 | 68 | when cmdJson $ putStrLn $ showWarningsJson warns 69 | when cmdYaml $ putStrLn $ showWarningsYaml warns 70 | if cmdMatch then 71 | if sort ignore == sort warns then do 72 | putStrLn "Warnings match" 73 | return 0 74 | else do 75 | putStrLn "MISSING WARNINGS" 76 | putStrLn $ unlines $ showWarningsPretty "" $ ignore \\ warns 77 | putStrLn "EXTRA WARNINGS" 78 | putStrLn $ unlines $ showWarningsPretty "" $ warns \\ ignore 79 | return 1 80 | else do 81 | when (ignored > 0 && not quiet) $ 82 | putStrLn $ "Ignored " ++ show ignored ++ " weeds (pass --show-all to see them)" 83 | return $ length warns 84 | -------------------------------------------------------------------------------- /src/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, TupleSections #-} 2 | 3 | module Util( 4 | Str, 5 | FilePathEq, filePathEq, 6 | PackageName, ModuleName, IdentName, 7 | parseHanging, 8 | parseHanging2, unindent2, 9 | (?:), 10 | isHaskellCtor, 11 | isHaskellSymbol, 12 | reachable, 13 | isPathsModule, 14 | cmd, cmdStdout 15 | ) where 16 | 17 | import Data.Char 18 | import Data.Monoid 19 | import Data.Hashable 20 | import Data.List.Extra 21 | import Data.Tuple.Extra 22 | import System.Process 23 | import System.FilePath 24 | import System.Directory 25 | import System.Info.Extra 26 | import System.Console.CmdArgs.Verbosity 27 | import Str(Str) 28 | import qualified Str as S 29 | import qualified Data.HashSet as Set 30 | import Prelude 31 | 32 | 33 | type PackageName = String 34 | type ModuleName = String 35 | type IdentName = String 36 | 37 | 38 | -- | Return the first non-empty argument in a left-to-right manner 39 | (?:) :: (Eq a, Monoid a) => a -> a -> a 40 | a ?: b = if a == mempty then b else a 41 | 42 | -- | Parse a hanging lines of lines. 43 | parseHanging :: [String] -> [(String, [String])] 44 | parseHanging = repeatedly (\(x:xs) -> first (\a -> (x, unindent a)) $ span (maybe True ((== ' ') . fst) . uncons) xs) 45 | 46 | parseHanging2 :: [Str] -> [(Str, [Str])] 47 | parseHanging2 = repeatedly (\(x:xs) -> first (x,) $ span (maybe True ((== ' ') . fst) . S.uncons) xs) 48 | 49 | unindent :: [String] -> [String] 50 | unindent xs = map (drop n) xs 51 | where 52 | n = minimum $ top : map f xs 53 | f x = let (a,b) = span isSpace x in if null b then top else length a 54 | top = 1000 55 | 56 | unindent2 :: [Str] -> [Str] 57 | unindent2 xs = map (S.drop n) xs 58 | where 59 | n = minimum $ top : map f xs 60 | f x = let (a,b) = S.span isSpace x in if S.null b then top else S.length a 61 | top = S.ugly 1000 62 | 63 | -- | Is the character a member of possible Haskell symbol characters, 64 | -- according to the Haskell report. 65 | isHaskellSymbol :: Char -> Bool 66 | isHaskellSymbol x = 67 | x `elem` ("!#$%&*+./<=>?@\\^|-~" :: String) || 68 | (isSymbol x && x `notElem` ("\"'_(),;[]`{}" :: String)) 69 | 70 | isHaskellCtor :: IdentName -> Bool 71 | isHaskellCtor [] = False 72 | isHaskellCtor (x:xs) = isUpper x || x == ':' 73 | 74 | -- | Normal 'FilePath' has 'Eq' but it allows non-normalised paths 75 | -- and on Windows/Mac is case-sensitive even when the underlying file system isn't. 76 | newtype FilePathEq = FilePathEq FilePath 77 | deriving (Hashable,Eq,Ord,Show) 78 | 79 | filePathEq :: FilePath -> FilePathEq 80 | filePathEq = FilePathEq . (if isWindows || isMac then lower else id) . normalise 81 | 82 | -- | Given a list of mappings, and an initial set, find which items can be reached 83 | reachable :: (Eq k, Hashable k) => (k -> [k]) -> [k] -> Set.HashSet k 84 | reachable follow = f Set.empty 85 | where 86 | f done [] = done 87 | f done (x:xs) 88 | | x `Set.member` done = f done xs 89 | | otherwise = f (Set.insert x done) $ follow x ++ xs 90 | 91 | -- | Is a given module name the specially generated cabal Paths_foo module 92 | isPathsModule :: ModuleName -> Bool 93 | isPathsModule = isPrefixOf "Paths_" 94 | 95 | 96 | cmdTrace :: FilePath -> [String] -> IO () 97 | cmdTrace exe args = whenLoud $ do 98 | dir <- getCurrentDirectory 99 | putStrLn $ "Running: " ++ showCommandForUser exe args ++ " (in " ++ dir ++ ")" 100 | 101 | cmd :: FilePath -> [String] -> IO () 102 | cmd exe args = do 103 | cmdTrace exe args 104 | callProcess exe args 105 | 106 | cmdStdout :: FilePath -> [String] -> IO String 107 | cmdStdout exe args = do 108 | cmdTrace exe args 109 | readCreateProcess (proc exe args) "" 110 | -------------------------------------------------------------------------------- /src/Warning.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} 2 | 3 | module Warning( 4 | Warning(..), 5 | showWarningsPretty, 6 | showWarningsYaml, 7 | showWarningsJson, 8 | readWarningsFile, 9 | ignoreWarnings 10 | ) where 11 | 12 | import Cabal 13 | import Util 14 | import Control.Monad.Extra 15 | import Data.Maybe 16 | import Data.List.Extra 17 | import Control.Exception 18 | import Data.Aeson as JSON 19 | import Data.Yaml as Yaml 20 | import qualified Data.Vector as V 21 | import qualified Data.Text as T 22 | import qualified Data.HashMap.Strict as Map 23 | import qualified Data.ByteString.Char8 as BS 24 | import qualified Data.ByteString.Lazy.Char8 as LBS 25 | 26 | 27 | data Warning = Warning 28 | {warningPackage :: String 29 | ,warningSections :: [CabalSectionType] 30 | ,warningMessage :: String 31 | ,warningDepends :: Maybe PackageName 32 | ,warningModule :: Maybe ModuleName 33 | ,warningIdentifier :: Maybe IdentName 34 | } deriving (Show,Eq,Ord) 35 | 36 | warningLabels = ["package","section","message","depends","module","identifier"] 37 | 38 | warningPath :: Warning -> [Maybe String] 39 | warningPath Warning{..} = 40 | [Just warningPackage 41 | ,Just $ unwords $ map show warningSections 42 | ,Just warningMessage 43 | ,warningDepends 44 | ,warningModule 45 | ,warningIdentifier] 46 | 47 | warningUnpath :: [String] -> Warning 48 | warningUnpath [pkg,sect,msg,deps,mod,ident] = Warning 49 | pkg (map read $ words sect) msg 50 | (f deps) (f mod) (f ident) 51 | where f s = if null s then Nothing else Just s 52 | 53 | showWarningsPretty :: PackageName -> [Warning] -> [String] 54 | showWarningsPretty pkg [] = ["= Package " ++ pkg ++ " =","No warnings"] 55 | showWarningsPretty _ warn = warningTree 56 | ([\x -> "= Package " ++ x ++ " =",\x -> "\n== Section " ++ x ++ " ==",id,("* "++),(" - "++)] ++ repeat id) $ 57 | map (catMaybes . warningPath) warn 58 | 59 | warningTree :: Ord a => [a -> a] -> [[a]] -> [a] 60 | warningTree (f:fs) xs = concat 61 | [ f title : warningTree fs inner 62 | | (title,inner) <- groupSort $ mapMaybe uncons xs] 63 | 64 | 65 | -- (section, name, children) 66 | data Val = Val String String [Val] 67 | | End String [String] 68 | deriving Show 69 | 70 | valToValue :: [Val] -> Value 71 | valToValue = Array . V.fromList . map f 72 | where 73 | pair k v = Object $ Map.singleton (T.pack k) v 74 | f (Val sect name xs) = pair sect $ Array $ V.fromList $ 75 | pair "name" (String $ T.pack name) : map f xs 76 | f (End sect [x]) = pair sect $ String $ T.pack x 77 | f (End sect xs) = pair sect $ Array $ V.fromList $ map (String . T.pack) xs 78 | 79 | valueToVal :: Value -> [Val] 80 | valueToVal = f 81 | where 82 | badYaml want x = error $ "Failed to understand Yaml fragment, expected " ++ want ++ ", got:\n" ++ BS.unpack (Yaml.encode x) 83 | 84 | f Null = [] 85 | f (Object mp) | Map.null mp = [] 86 | f (Array xs) = concatMap f $ V.toList xs 87 | f (Object mp) | [(k,v)] <- Map.toList mp = return $ case v of 88 | v | Just (n, rest) <- findName v -> Val (T.unpack k) (T.unpack n) $ f rest 89 | v | Just xs <- fromStrings v -> End (T.unpack k) xs 90 | String x -> End (T.unpack k) [T.unpack x] 91 | _ -> badYaml "either a dict with 'name' or a list/single string" $ Object mp 92 | f x = badYaml "either a singleton dict or an array" x 93 | 94 | fromStrings (Array xs) = concatMapM fromStrings $ V.toList xs 95 | fromStrings (String x) = Just [T.unpack x] 96 | fromStrings x = Nothing 97 | 98 | findName (Array xs) 99 | | ([name], rest) <- partition (isJust . fromName) $ V.toList xs 100 | = Just (fromJust $ fromName name, Array $ V.fromList rest) 101 | findName _ = Nothing 102 | 103 | fromName (Object mp) | [(k,String v)] <- Map.toList mp, T.unpack k == "name" = Just v 104 | fromName _ = Nothing 105 | 106 | showWarningsValue :: [Warning] -> Value 107 | showWarningsValue = valToValue . f warningLabels . map (dropWhileEnd isNothing . warningPath) 108 | where 109 | f (name:names) xs 110 | | all (\x -> length x <= 1) xs = [End name $ sort [x | [Just x] <- xs] | xs /= []] 111 | | otherwise = concat 112 | [ case a of 113 | Nothing -> f names b 114 | Just a -> [Val name a $ f names b] 115 | | (a,b) <- groupSort $ mapMaybe uncons xs] 116 | 117 | showWarningsJson :: [Warning] -> String 118 | showWarningsJson = LBS.unpack . JSON.encode . showWarningsValue 119 | 120 | showWarningsYaml :: [Warning] -> String 121 | showWarningsYaml [] = "" -- no need to write anything in the file 122 | showWarningsYaml xs = BS.unpack $ Yaml.encode $ showWarningsValue xs 123 | 124 | 125 | readWarningsFile :: FilePath -> IO [Warning] 126 | readWarningsFile file = do 127 | x <- eitherM throwIO return $ Yaml.decodeFileEither file 128 | let res = map warningUnpath $ concatMap (f warningLabels) $ valueToVal x 129 | mapM_ evaluate res -- ensure exceptions happen immediately 130 | return res 131 | where 132 | f :: [String] -> Val -> [[String]] 133 | f names (End sect ns) = concatMap (\n -> f names $ Val sect n []) ns 134 | f (name:names) val@(Val sect n xs) 135 | | sect == name = if null xs 136 | then [n : replicate (length names) ""] 137 | else map (n:) $ concatMap (f names) xs 138 | | sect `notElem` names = error $ 139 | "Warnings file " ++ file ++ ", invalid section name:\n" ++ 140 | "Wanted one of: " ++ show (name:names) ++ "\n" ++ 141 | "Got: " ++ show sect 142 | | otherwise = map ("":) $ f names val 143 | 144 | 145 | -- | Ignore all found warnings that are covered by a template 146 | ignoreWarnings :: [Warning] -> [Warning] -> [Warning] 147 | ignoreWarnings template = filter (\x -> not $ any (`match` x) template) 148 | where 149 | unpack = map (fromMaybe "") . warningPath 150 | match template found = and $ zipWith (\t f -> t == "" || t == f) (unpack template) (unpack found) 151 | -------------------------------------------------------------------------------- /src/Cabal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns, RecordWildCards #-} 2 | 3 | module Cabal( 4 | Cabal(..), CabalSection(..), CabalSectionType, 5 | parseCabal, 6 | selectCabalFile, 7 | selectHiFiles 8 | ) where 9 | 10 | import System.IO.Extra 11 | import System.Directory.Extra 12 | import System.FilePath 13 | import qualified Data.HashMap.Strict as Map 14 | import Util 15 | import Data.Char 16 | import Data.Maybe 17 | import Data.List.Extra 18 | import Data.Tuple.Extra 19 | import Data.Either.Extra 20 | import Data.Semigroup 21 | import Prelude 22 | 23 | 24 | selectCabalFile :: FilePath -> IO FilePath 25 | selectCabalFile dir = do 26 | xs <- listFiles dir 27 | case filter ((==) ".cabal" . takeExtension) xs of 28 | [x] -> return x 29 | _ -> fail $ "Didn't find exactly 1 cabal file in " ++ dir 30 | 31 | -- | Return the (exposed Hi files, internal Hi files, not found) 32 | selectHiFiles :: FilePath -> Map.HashMap FilePathEq a -> CabalSection -> ([a], [a], [ModuleName]) 33 | selectHiFiles distDir his sect@CabalSection{..} = (external, internal, bad1++bad2) 34 | where 35 | (bad1, external) = partitionEithers $ 36 | [findHi his sect $ Left cabalMainIs | cabalMainIs /= ""] ++ 37 | [findHi his sect $ Right x | x <- cabalExposedModules] 38 | (bad2, internal) = partitionEithers 39 | [findHi his sect $ Right x | x <- filter (not . isPathsModule) cabalOtherModules] 40 | 41 | findHi :: Map.HashMap FilePathEq a -> CabalSection -> Either FilePath ModuleName -> Either ModuleName a 42 | findHi his cabal@CabalSection{..} name = 43 | -- error $ show (poss, Map.keys his) 44 | maybe (Left mname) Right $ firstJust (`Map.lookup` his) poss 45 | where 46 | mname = either takeFileName id name 47 | poss = map filePathEq $ possibleHi distDir cabalSourceDirs cabalSectionType $ either (return . dropExtension) (splitOn ".") name 48 | 49 | 50 | -- | This code is fragile and keeps going wrong, should probably try a less "guess everything" 51 | -- and a more refined filter and test. 52 | possibleHi :: FilePath -> [FilePath] -> CabalSectionType -> [String] -> [FilePath] 53 | possibleHi distDir sourceDirs sectionType components = 54 | [ joinPath (root : x : components) <.> "dump-hi" 55 | | extra <- [".",distDir] 56 | , root <- concat [["build" extra x (x ++ "-tmp") 57 | ,"build" extra x x 58 | ,"build" extra x (x ++ "-tmp") distDir "build" x (x ++ "-tmp")] 59 | | Just x <- [cabalSectionTypeName sectionType]] ++ 60 | ["build", "build" distDir "build"] 61 | , x <- sourceDirs ++ ["."]] 62 | 63 | 64 | data Cabal = Cabal 65 | {cabalName :: PackageName 66 | ,cabalSections :: [CabalSection] 67 | } deriving Show 68 | 69 | instance Semigroup Cabal where 70 | Cabal x1 x2 <> Cabal y1 y2 = Cabal (x1?:y1) (x2++y2) 71 | 72 | instance Monoid Cabal where 73 | mempty = Cabal "" [] 74 | mappend = (<>) 75 | 76 | data CabalSectionType = Library (Maybe String) | Executable String | TestSuite String | Benchmark String 77 | deriving (Eq,Ord) 78 | 79 | cabalSectionTypeName :: CabalSectionType -> Maybe String 80 | cabalSectionTypeName (Library x) = x 81 | cabalSectionTypeName (Executable x) = Just x 82 | cabalSectionTypeName (TestSuite x) = Just x 83 | cabalSectionTypeName (Benchmark x) = Just x 84 | 85 | instance Show CabalSectionType where 86 | show (Library Nothing) = "library" 87 | show (Library (Just x)) = "library:" ++ x 88 | show (Executable x) = "exe:" ++ x 89 | show (TestSuite x) = "test:" ++ x 90 | show (Benchmark x) = "bench:" ++ x 91 | 92 | instance Read CabalSectionType where 93 | readsPrec _ "library" = [(Library Nothing,"")] 94 | readsPrec _ x 95 | | Just x <- stripPrefix "exe:" x = [(Executable x, "")] 96 | | Just x <- stripPrefix "test:" x = [(TestSuite x, "")] 97 | | Just x <- stripPrefix "bench:" x = [(Benchmark x, "")] 98 | | Just x <- stripPrefix "library:" x = [(Library (Just x), "")] 99 | readsPrec _ _ = [] 100 | 101 | data CabalSection = CabalSection 102 | {cabalSectionType :: CabalSectionType 103 | ,cabalMainIs :: FilePath 104 | ,cabalExposedModules :: [ModuleName] 105 | ,cabalOtherModules :: [ModuleName] 106 | ,cabalSourceDirs :: [FilePath] 107 | ,cabalPackages :: [PackageName] 108 | } deriving Show 109 | 110 | instance Semigroup CabalSection where 111 | CabalSection x1 x2 x3 x4 x5 x6 <> CabalSection y1 y2 y3 y4 y5 y6 = 112 | CabalSection x1 (x2?:y2) (x3<>y3) (x4<>y4) (x5<>y5) (x6<>y6) 113 | 114 | instance Monoid CabalSection where 115 | mempty = CabalSection (Library Nothing) "" [] [] [] [] 116 | mappend = (<>) 117 | 118 | parseCabal :: FilePath -> IO Cabal 119 | parseCabal = fmap parseTop . readFile' 120 | 121 | parseTop = mconcatMap f . parseHanging . filter (not . isComment) . lines 122 | where 123 | isComment = isPrefixOf "--" . trimStart 124 | keyName = (lower *** fst . word1) . word1 125 | 126 | f (keyName -> (key, name), xs) = case key of 127 | "name:" -> mempty{cabalName=name} 128 | "library" -> case name of 129 | "" -> mempty{cabalSections=[parseSection (Library Nothing) xs]} 130 | x -> mempty{cabalSections=[parseSection (Library (Just x)) xs]} 131 | "executable" -> mempty{cabalSections=[parseSection (Executable name) xs]} 132 | "test-suite" -> mempty{cabalSections=[parseSection (TestSuite name) xs]} 133 | "benchmark" -> mempty{cabalSections=[parseSection (Benchmark name) xs]} 134 | _ -> mempty 135 | 136 | parseSection typ xs = mempty{cabalSectionType=typ} <> parse xs 137 | where 138 | parse = mconcatMap f . parseHanging 139 | keyValues (x,xs) = let (x1,x2) = word1 x in (lower x1, trimEqual $ filter (not . null) $ x2:xs) 140 | trimEqual xs = map (drop n) xs 141 | where n = minimum $ 0 : map (length . takeWhile isSpace) xs 142 | listSplit = concatMap (wordsBy (`elem` " ,")) 143 | isPackageNameChar x = isAlphaNum x || x == '-' 144 | parsePackage = dropSuffix "-any" . takeWhile isPackageNameChar . trim 145 | 146 | f (keyValues -> (k,vs)) = case k of 147 | "if" -> parse vs 148 | "else" -> parse vs 149 | "build-depends:" -> mempty{cabalPackages = map parsePackage . splitOn "," $ unwords vs} 150 | "hs-source-dirs:" -> mempty{cabalSourceDirs=listSplit vs} 151 | "exposed-modules:" -> mempty{cabalExposedModules=listSplit vs} 152 | "other-modules:" -> mempty{cabalOtherModules=listSplit vs} 153 | "main-is:" -> mempty{cabalMainIs=headDef "" vs} 154 | _ -> mempty 155 | -------------------------------------------------------------------------------- /src/Check.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} 2 | 3 | module Check(check) where 4 | 5 | import Hi 6 | import Cabal 7 | import Util 8 | import Data.Maybe 9 | import Data.List.Extra 10 | import Data.Tuple.Extra 11 | import System.Info.Extra 12 | import qualified Data.HashSet as Set 13 | import qualified Data.HashMap.Strict as Map 14 | import Warning 15 | 16 | 17 | data S = S 18 | {pkg :: PackageName 19 | ,hi :: HiKey -> Hi 20 | ,sections :: [(CabalSection, ([HiKey], [HiKey], [ModuleName]))] 21 | } 22 | 23 | check :: (HiKey -> Hi) -> PackageName -> [(CabalSection, ([HiKey], [HiKey], [ModuleName]))] -> [Warning] 24 | check hi pkg sections2 = map (\x -> x{warningSections = sort $ warningSections x}) $ 25 | warnReusedModuleBetweenSections s ++ 26 | warnRedundantPackageDependency s ++ 27 | warnIncorrectOtherModules s ++ 28 | warnUnusedExport s ++ 29 | warnNotCompiled s ++ 30 | warnUnusedImport s 31 | where 32 | s = S{..} 33 | sections = map (second $ \(a,b,c) -> let aa = nubOrd a in (aa,nubOrd b \\ aa,c)) sections2 34 | 35 | 36 | warnNotCompiled :: S -> [Warning] 37 | warnNotCompiled S{..} = 38 | [ Warning pkg [cabalSectionType s] "Module not compiled" Nothing (Just m) Nothing 39 | | (s, (_, _, missing)) <- sections, m <- missing] 40 | 41 | 42 | warnReusedModuleBetweenSections :: S -> [Warning] 43 | warnReusedModuleBetweenSections S{..} = 44 | [ Warning pkg ss "Module reused between components" Nothing (Just $ hiModuleName $ hi m) Nothing 45 | | (m, ss) <- groupSort [(x, cabalSectionType c) | (c, (x1,x2,_)) <- sections, x <- x1++x2] 46 | , length ss > 1] 47 | 48 | 49 | warnRedundantPackageDependency :: S -> [Warning] 50 | warnRedundantPackageDependency S{..} = 51 | [ Warning pkg [cabalSectionType] "Redundant build-depends entry" (Just p) Nothing Nothing 52 | | (CabalSection{..}, (x1,x2,_)) <- sections 53 | , let usedPackages = Set.unions $ map (Set.map fst . hiImportPackageModule . hi) $ x1 ++ x2 54 | , not $ "" `Set.member` usedPackages -- Sometimes we don't get the package name at all, e.g. https://gitlab.haskell.org/ghc/ghc/issues/16886 55 | , p <- Set.toList $ Set.fromList cabalPackages `Set.difference` usedPackages 56 | , p /= if isWindows then "unix" else "Win32" -- ignore packages that must be conditional on the other platform 57 | , p /= "semigroups" -- ignore packages that are often conditional 58 | , p /= "base" -- used by Paths_ modules which we have thrown away by this point 59 | ] 60 | 61 | 62 | warnIncorrectOtherModules :: S -> [Warning] 63 | warnIncorrectOtherModules S{..} = concat 64 | [ [Warning pkg [cabalSectionType] "Missing other-modules entry" Nothing (Just m) Nothing | m <- Set.toList missing] ++ 65 | [Warning pkg [cabalSectionType] "Excessive other-modules entry" Nothing (Just m) Nothing | m <- Set.toList excessive] 66 | | (CabalSection{..}, (external, internal,_)) <- sections 67 | , let imports = Map.fromList [(hiModuleName, hiImportModule) | Hi{..} <- map hi $ external ++ internal] 68 | , let missing = Set.filter (not . isPathsModule) $ 69 | Set.unions (Map.elems imports) `Set.difference` 70 | Set.fromList (Map.keys imports) 71 | , let excessive = Set.fromList (map (hiModuleName . hi) internal) `Set.difference` 72 | reachable (\k -> maybe [] Set.toList $ Map.lookup k imports) (map (hiModuleName . hi) external) 73 | ] 74 | 75 | 76 | -- Primarily looking for import Foo() where Foo is not an orphan 77 | warnUnusedImport :: S -> [Warning] 78 | warnUnusedImport S{..} = 79 | [ Warning pkg [cabalSectionType] "Unused import" Nothing (Just $ hiModuleName mod) (Just $ hiModuleName imp) 80 | | (CabalSection{..}, (external, internal,_)) <- sections 81 | , let mods = Map.fromList $ map ((hiModuleName &&& id) . hi) $ external ++ internal 82 | , mod <- Map.elems mods 83 | , imp <- mapMaybe (`Map.lookup` mods) $ Set.toList $ 84 | hiImportModule mod `Set.difference` 85 | (Set.map identModule (hiImportIdent mod) `Set.union` hiImportOrphan mod) 86 | , Set.null $ hiImportIdent mod `Set.intersection` hiExportIdent imp -- reexporting for someone else 87 | , Set.null $ Set.map snd (hiImportPackageModule mod) `Set.intersection` Set.map identModule (hiExportIdent imp) -- reexporting for another package 88 | , 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 89 | ] 90 | 91 | warnUnusedExport :: S -> [Warning] 92 | warnUnusedExport S{..} = 93 | [ Warning pkg ss "Weeds exported" Nothing (Just $ hiModuleName $ hi m) (Just i) 94 | | (m,(ss,is)) <- Map.toList unused, i <- Set.toList is] 95 | where 96 | unionsWith f = foldr (Map.unionWith f) Map.empty 97 | -- important: for an identifer to be unused, it must be unused in all sections that use that key 98 | unused = unionsWith (\(s1,i1) (s2,i2) -> (s1++s2, i1 `Set.intersection` i2)) 99 | [ Map.fromList [(k, ([cabalSectionType], Set.fromList $ Map.lookupDefault [] (hiModuleName $ hi k) bad)) | k <- internal ++ external] 100 | | (CabalSection{..}, (external, internal,_)) <- sections 101 | , let bad = Map.fromListWith (++) $ map (identModule &&& return . identName) $ notUsedOrExposed (map hi external) (map hi internal)] 102 | 103 | notUsedOrExposed :: [Hi] -> [Hi] -> [Ident] 104 | notUsedOrExposed external internal = Set.toList $ 105 | privateAPI `Set.difference` Set.unions [publicAPI,supported,usedAnywhere] 106 | where 107 | modules = Map.fromList [(hiModuleName x, x) | x <- external ++ internal] 108 | 109 | -- things exported from this package 110 | publicAPI = Set.unions $ map hiExportIdent external 111 | 112 | -- Types that are required to define things that are public 113 | supported = Set.unions 114 | [ Map.lookupDefault Set.empty x hiSignatures 115 | | (m, xs) <- groupSort $ map (identModule &&& identName) $ Set.toList $ Set.union publicAPI usedAnywhere 116 | , Just Hi{..} <- [Map.lookup m modules], x <- xs] 117 | 118 | -- things that are defined in other modules and exported 119 | -- (ignoring field name since they provide handy documentation) 120 | privateAPI = Set.unions 121 | [ Set.filter ((==) hiModuleName . identModule) $ hiExportIdent `Set.difference` hiFieldName 122 | | Hi{..} <- internal] 123 | 124 | -- things that are used anywhere, if someone imports and exports something 125 | -- assume that isn't also a use (find some redundant warnings) 126 | usedAnywhere = Set.unions 127 | [ hiImportIdent `Set.difference` hiExportIdent 128 | | Hi{..} <- external ++ internal] 129 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 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/nightly?label=Stackage)](https://www.stackage.org/package/weeder) [![Linux build status](https://img.shields.io/travis/ndmitchell/weeder/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/weeder) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/weeder/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/ndmitchell/weeder) 2 | 3 | # Weeder has moved! 4 | 5 | Weeder 2.0 is being developed at https://github.com/ocharles/weeder on different foundations. This repo is for historical reference only. 6 | 7 | ------------------- 8 | 9 | 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: 10 | 11 | * Install `weeder` by running `stack install weeder --resolver=nightly`. 12 | * Ensure your project has a `stack.yaml` file. If you don't normally build with `stack` then run `stack init` to generate one. 13 | * Make sure you have `ghc-options: {"$locals": -ddump-to-file -ddump-hi}` in your `stack.yaml`. 14 | * Run `weeder . --build`, which builds your project with `stack` and reports any weeds. 15 | 16 | ## What does Weeder detect? 17 | 18 | Weeder detects a bunch of weeds, including: 19 | 20 | * You export a function `helper` from module `Foo.Bar`, but nothing else in your package uses `helper`, and `Foo.Bar` is not an `exposed-module`. Therefore, the export of `helper` is a weed. Note that `helper` itself may or may not be a weed - once it is no longer exported `-fwarn-unused-binds` will tell you if it is entirely redundant. 21 | * Your package `depends` on another package but doesn't use anything from it - the dependency should usually be deleted. This functionality is quite like [packunused](https://hackage.haskell.org/package/packunused), but implemented quite differently. 22 | * Your package has entries in the `other-modules` field that are either unused (and thus should be deleted), or are missing (and thus should be added). The `stack` tool warns about the latter already. 23 | * A source file is used between two different sections in a `.cabal` file - e.g. in both the library and the executable. Usually it's better to arrange for the executable to depend on the library, but sometimes that would unnecessarily pollute the interface. Useful to be aware of, and sometimes worth fixing, but not always. 24 | * A file has not been compiled despite being mentioned in the `.cabal` file. This situation can be because the file is unused, or the `stack` compilation was incomplete. I recommend compiling both benchmarks and tests to avoid this warning where possible - running `weeder . --build` will use a suitable command line. 25 | 26 | Beware of conditional compilation (e.g. `CPP` and the [Cabal `flag` mechanism](https://www.haskell.org/cabal/users-guide/developing-packages.html#configurations)), as these may mean that something is currently a weed, but in different configurations it is not. 27 | 28 | I recommend fixing the warnings relating to `other-modules` and files not being compiled first, as these may cause other warnings to disappear. 29 | 30 | ## What else should I use? 31 | 32 | Weeder detects dead exports, which can be deleted. To get the most code deleted from removing an export, use: 33 | 34 | * GHC with `-fwarn-unused-binds -fwarn-unused-imports`, which finds unused definitions and unused imports in a module. 35 | * [HLint](https://github.com/ndmitchell/hlint#readme), looking for "Redundant extension" hints, which finds unused extensions. 36 | * [Unused](https://github.com/joshuaclayton/unused), which works at the level of `ctags` information, so can be used if you don't want to use `stack`, can't compile your code, or want to detect unused code between projects. 37 | 38 | ## Ignoring weeds 39 | 40 | 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`. 41 | 42 | You may wish to generalise/simplify the `.weeder.yaml` by removing anything above or below the interesting part. As an example of the [`.weeder.yaml` file from `ghcid`](https://github.com/ndmitchell/ghcid/blob/master/.weeder.yaml): 43 | 44 | ```yaml 45 | - message: Module reused between components 46 | - message: 47 | - name: Weeds exported 48 | - identifier: withWaiterPoll 49 | ``` 50 | 51 | This configuration declares that I am not interested in the message about modules being reused between components (that's the way `ghcid` works, and I am aware of it). It also says that I am not concerned about `withWaiterPoll` being a weed - it's a simplified method of file change detection I use for debugging, so even though it's dead now, I sometimes do switch to it. 52 | 53 | ## Running with Continuous Integration 54 | 55 | Before running Weeder on your continuous integration (CI) server, you should first ensure there are no existing weeds. One way to achieve that is to ignore existing hints by running `weeder . --yaml > .weeder.yaml` and checking in the resulting `.weeder.yaml`. 56 | 57 | On the CI you should then run `weeder .` (or `weeder . --build` to compile as well). To avoid the cost of compilation you may wish to fetch the [latest Weeder binary release](https://github.com/ndmitchell/weeder/releases/latest). 58 | 59 | For the CI systems [Travis](https://travis-ci.org/), [Appveyor](https://www.appveyor.com/) and [Azure Pipelines](https://azure.microsoft.com/en-gb/services/devops/pipelines/) add the line: 60 | 61 | ```sh 62 | curl -sSL https://raw.github.com/ndmitchell/weeder/master/misc/run.sh | sh -s . 63 | ``` 64 | 65 | The arguments after `-s` are passed to `weeder`, so modify the final `.` if you want other arguments. This command works on Windows, Mac and Linux. 66 | 67 | ## What about Cabal users? 68 | 69 | 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. 70 | 71 | ## What about false positives? 72 | 73 | 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: 74 | 75 | **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. 76 | 77 | **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. 78 | 79 | **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. 80 | 81 | **Linking to C functions** If a library provides C functions, and these are used directly from another library/executable, the library providing these functions may be marked as a redundant `build-depends`, see [more details](https://github.com/ndmitchell/weeder/issues/40). 82 | -------------------------------------------------------------------------------- /src/Hi.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric, RecordWildCards, GeneralizedNewtypeDeriving, OverloadedStrings #-} 2 | 3 | module Hi( 4 | HiKey(), Hi(..), Ident(..), 5 | hiParseDirectory 6 | ) where 7 | 8 | import qualified Data.HashSet as Set 9 | import qualified Data.HashMap.Lazy as Map 10 | import System.Console.CmdArgs.Verbosity 11 | import System.FilePath 12 | import System.Directory.Extra 13 | import System.Time.Extra 14 | import GHC.Generics 15 | import Data.Tuple.Extra 16 | import Data.Maybe 17 | import Control.Monad 18 | import Control.Exception 19 | import Control.DeepSeq 20 | import Data.Char 21 | import Data.Hashable 22 | import Data.List.Extra 23 | import Data.Semigroup 24 | import Data.Functor 25 | import Util 26 | import qualified Str as S 27 | import System.IO.Extra 28 | import Prelude 29 | 30 | data Ident = Ident {identModule :: ModuleName, identName :: IdentName} 31 | deriving (Show,Eq,Ord,Generic) 32 | instance Hashable Ident 33 | instance NFData Ident 34 | 35 | data Hi = Hi 36 | {hiModuleName :: ModuleName 37 | -- ^ Module name 38 | ,hiImportPackage :: Set.HashSet PackageName 39 | -- ^ Packages imported by this module 40 | ,hiExportIdent :: Set.HashSet Ident 41 | -- ^ Identifiers exported by this module 42 | ,hiImportIdent :: Set.HashSet Ident 43 | -- ^ Identifiers used by this module 44 | ,hiImportModule :: Set.HashSet ModuleName 45 | -- ^ Modules imported and used by this module 46 | -- Normally equivalent to @Set.map identModule hiImportIdent@, unless a module supplies only instances 47 | ,hiImportOrphan :: Set.HashSet ModuleName 48 | -- ^ Orphans that are in scope in this module 49 | ,hiImportPackageModule :: Set.HashSet (PackageName, ModuleName) 50 | -- ^ Modules imported from other packages 51 | ,hiSignatures :: Map.HashMap IdentName (Set.HashSet Ident) 52 | -- ^ Type signatures of functions defined in this module and the types they refer to 53 | ,hiFieldName :: Set.HashSet Ident 54 | -- ^ Things that are field names 55 | } deriving (Show,Eq,Generic) 56 | instance Hashable Hi 57 | instance NFData Hi 58 | 59 | instance Semigroup Hi where 60 | x <> y = Hi 61 | {hiModuleName = f (?:) hiModuleName 62 | ,hiImportPackage = f (<>) hiImportPackage 63 | ,hiExportIdent = f (<>) hiExportIdent 64 | ,hiImportIdent = f (<>) hiImportIdent 65 | ,hiImportModule = f (<>) hiImportModule 66 | ,hiImportPackageModule = f (<>) hiImportPackageModule 67 | ,hiImportOrphan = f (<>) hiImportOrphan 68 | ,hiSignatures = f (Map.unionWith (<>)) hiSignatures 69 | ,hiFieldName = f (<>) hiFieldName 70 | } 71 | where f op sel = sel x `op` sel y 72 | 73 | instance Monoid Hi where 74 | mempty = Hi mempty mempty mempty mempty mempty mempty mempty mempty mempty 75 | mappend = (<>) 76 | 77 | -- | Don't expose that we're just using the filename internally 78 | newtype HiKey = HiKey FilePathEq deriving (Eq,Ord,Hashable) 79 | 80 | hiParseDirectory :: FilePath -> IO (Map.HashMap FilePathEq HiKey, Map.HashMap HiKey Hi) 81 | hiParseDirectory dir = do 82 | whenLoud $ putStrLn $ "Reading hi directory " ++ dir 83 | files <- filter ((==) ".dump-hi" . takeExtension) <$> listFilesRecursive dir 84 | his <- forM files $ \file -> do 85 | let name = drop (length dir + 1) file 86 | whenLoud $ do 87 | putStr $ "Reading hi file " ++ name ++ " ... " 88 | hFlush stdout 89 | (time, (len, res)) <- duration $ do 90 | src <- S.readFileUTF8 file 91 | len <- evaluate $ S.length src 92 | let res = trimSignatures $ hiParseContents src 93 | evaluate $ rnf res 94 | return (len, res) 95 | whenLoud $ putStrLn $ S.showLength len ++ " bytes in " ++ showDuration time 96 | return (filePathEq name, res) 97 | -- here we try and dedupe any identical Hi modules 98 | let keys = Map.fromList $ map (second HiKey . swap) his 99 | mp1 <- evaluate $ Map.fromList $ map (second (keys Map.!)) his 100 | mp2 <- evaluate $ Map.fromList $ map swap $ Map.toList keys 101 | whenLoud $ putStrLn $ "Found " ++ show (Map.size mp1) ++ " files, " ++ show (Map.size mp2) ++ " distinct" 102 | return (mp1, mp2) 103 | 104 | -- note that in some cases we may get more/less internal signatures, so first remove them 105 | trimSignatures :: Hi -> Hi 106 | trimSignatures hi@Hi{..} = hi{hiSignatures = Map.filterWithKey (\k _ -> k `Set.member` names) hiSignatures} 107 | where names = Set.fromList [s | Ident m s <- Set.toList hiExportIdent, m == hiModuleName] 108 | 109 | hiParseContents :: Str -> Hi 110 | hiParseContents = mconcatMap f . parseHanging2 . S.linesCR 111 | where 112 | f (x,xs) 113 | | Just x <- S.stripPrefix "interface " x = mempty{hiModuleName = parseInterface $ S.toList x} 114 | | Just x <- S.stripPrefix "exports:" x = mconcatMap (parseExports . S.toList) $ unindent2 xs 115 | | Just x <- S.stripPrefix "orphans:" x = mempty{hiImportOrphan = Set.fromList $ map parseInterface $ concatMap (words . S.toList) $ x:xs} 116 | | Just x <- S.stripPrefix "package dependencies:" x = mempty{hiImportPackage = Set.fromList $ map parsePackDep $ concatMap (words . S.toList) $ x:xs} 117 | | Just x <- S.stripPrefix "import " x = case unindent2 xs of 118 | [] | let s = words (S.toList x) !! 1 119 | , (pkg, mod) <- fromMaybe ("", s) $ stripInfix ":" s -> mempty 120 | {hiImportPackageModule = Set.singleton (parsePackDep pkg, mod)} 121 | xs -> let m = words (S.toList x) !! 1 in mempty 122 | {hiImportModule = Set.singleton m 123 | ,hiImportIdent = Set.fromList $ map (Ident m . fst . word1 . S.toList) $ dropWhile ("exports:" `S.isPrefixOf`) xs} 124 | | S.length x == S.ugly 32, S.all isHexDigit x, 125 | (y,ys):_ <- parseHanging2 $ map (S.drop $ S.ugly 2) xs, 126 | fun:"::":typ <- concatMap (wordsBy (`elem` (",()[]{} " :: String)) . S.toList) $ y:ys, 127 | not $ "$" `isPrefixOf` fun = 128 | mempty{hiSignatures = Map.singleton fun $ Set.fromList $ map parseIdent typ} 129 | | otherwise = mempty 130 | 131 | -- "old-locale-1.0.0.7@old-locale-1.0.0.7-KGBP1BSKxH5GCm0LnZP04j" -> "old-locale" 132 | -- "old-locale-1.0.0.7" -> "old-locale" 133 | parsePackDep = intercalate "-" . takeWhile (any isAlpha) . wordsBy (== '-') . takeWhile (/= '@') 134 | 135 | -- "hlint-1.9.41-IPKy9tGF1918X9VRp9DMhp:HSE.All 8002" -> "HSE.All" 136 | -- "HSE.All 8002" -> "HSE.All" 137 | parseInterface = takeWhileEnd (/= ':') . fst . word1 138 | 139 | -- "Apply.applyHintFile" 140 | -- "Language.Haskell.PPHsMode{Language.Haskell.PPHsMode caseIndent} 141 | -- Return the identifiers and the fields. Fields are never qualified but everything else is. 142 | parseExports x = mempty 143 | {hiExportIdent = Set.fromList $ y : [Ident (a ?: identModule y) b | Ident a b <- ys] 144 | ,hiFieldName = Set.fromList [Ident (identModule y) b | Ident "" b <- ys] 145 | ,hiSignatures = Map.fromList [(b, Set.singleton y) | Ident _ b <- ys, b /= identName y] 146 | } 147 | where y:ys = map parseIdent $ wordsBy (`elem` ("{} " :: String)) x 148 | 149 | -- "Language.Haskell.PPHsMode" -> Ident "Language.Haskell" "PPHsMode" 150 | parseIdent x 151 | | isHaskellSymbol $ last x = 152 | let (a,b) = spanEnd isHaskellSymbol x 153 | in if null a then Ident "" b else Ident a $ tail b 154 | | otherwise = 155 | let (a,b) = breakOnEnd "." x 156 | in Ident (if null a then "" else init a) b 157 | --------------------------------------------------------------------------------