diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +# 0.1.2 + + - Add support for `Cabal-1.24` (and drop support for previous Cabal versions) + - Add experimental support for Stack + # 0.1.1.4 - Add support for `Cabal-1.22.*` and `base-4.8.*` diff --git a/packunused.cabal b/packunused.cabal --- a/packunused.cabal +++ b/packunused.cabal @@ -1,5 +1,5 @@ name: packunused -version: 0.1.1.4 +version: 0.1.2 synopsis: Tool for detecting redundant Cabal package dependencies homepage: https://github.com/hvr/packunused bug-reports: https://github.com/hvr/packunused/issues @@ -11,6 +11,7 @@ category: Distribution build-type: Simple cabal-version: >=1.10 +tested-with: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 description: This simple CLI tool allows to find out which of the packages listed as @build-depends@ in a Cabal package description file are redundant. @@ -31,6 +32,13 @@ > cabal build --ghc-option=-ddump-minimal-imports > packunused . + Experimental support for @stack@: + . + > stack setup --upgrade-cabal # necessary only when stack's global Cabal installation is out of date + > stack clean + > stack build --ghc-options '-ddump-minimal-imports -O0' + > packunused + . The @-O0 --disable-library-profiling@ options are just to speed up compilation. In some cases you might want to pass additional options to the @configure@ step, such as @--enable-benchmark@ or @@ -64,14 +72,15 @@ executable packunused main-is: packunused.hs + other-modules: Paths_packunused default-language: Haskell2010 other-extensions: CPP, RecordWildCards ghc-options: -Wall -fwarn-tabs -fno-warn-unused-do-bind - build-depends: - base >=4.5 && <4.9, - Cabal >=1.14 && <1.23, - optparse-applicative >=0.8 && <0.12, - directory >=1.1 && <1.3, - filepath ==1.3.*, - haskell-src-exts >=1.13 && <1.17, - split ==0.2.* + build-depends: base >= 4.5 && < 4.10 + , Cabal >= 1.24 && < 1.25 + , optparse-applicative >= 0.8 && < 0.14 + , directory >= 1.1 && < 1.4 + , filepath >= 1.3 && < 1.5 + , haskell-src-exts >= 1.18.2 && < 1.19 + , process >= 1.1 && < 1.5 + , split >= 0.2 && < 0.3 diff --git a/packunused.hs b/packunused.hs --- a/packunused.hs +++ b/packunused.hs @@ -9,27 +9,28 @@ import Data.Maybe import Data.Monoid import Data.Version (Version(Version), showVersion) -import Distribution.InstalledPackageInfo (exposedModules, installedPackageId) -#if MIN_VERSION_Cabal(1,21,0) +import Distribution.InstalledPackageInfo (exposedModules, InstalledPackageInfo) import Distribution.InstalledPackageInfo (exposedName) -#endif import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as MN -import Distribution.Package (InstalledPackageId(..), packageId, pkgName) +import Distribution.Package (PackageIdentifier, packageId, pkgName) +import Distribution.Package (UnitId(..), ComponentId(..), installedUnitId) import qualified Distribution.PackageDescription as PD import Distribution.Simple.Compiler -import Distribution.Simple.Configure (localBuildInfoFile, getPersistBuildConfig, checkPersistBuildConfigOutdated) +import Distribution.Simple.Configure (localBuildInfoFile, checkPersistBuildConfigOutdated) +import Distribution.Simple.Configure (tryGetPersistBuildConfig, ConfigStateFileError(..)) import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.PackageIndex (lookupInstalledPackageId) +import Distribution.Simple.PackageIndex (lookupUnitId, PackageIndex) import Distribution.Simple.Utils (cabalVersion) import Distribution.Text (display) import qualified Language.Haskell.Exts as H import Options.Applicative import Options.Applicative.Help.Pretty (Doc) import qualified Options.Applicative.Help.Pretty as P -import System.Directory (getModificationTime, getDirectoryContents, doesDirectoryExist, doesFileExist) +import System.Directory (getModificationTime, getDirectoryContents, doesDirectoryExist, doesFileExist, getCurrentDirectory) import System.Exit (exitFailure) -import System.FilePath (()) +import System.FilePath ((), takeDirectory) +import System.Process import Paths_packunused (version) @@ -54,6 +55,7 @@ "before executing 'packunused':", P.linebreak , P.hardline + , P.text "For cabal:" , P.indent 2 $ P.vcat $ P.text <$> [ "cabal clean" , "rm *.imports # (only needed for GHC<7.8)" @@ -61,7 +63,16 @@ , "cabal build --ghc-option=-ddump-minimal-imports" , "packunused" ] + , P.linebreak, P.hardline + , P.text "For stack:" + , P.indent 2 $ P.vcat $ P.text <$> + [ "stack clean" + , "stack build --ghc-options=-ddump-minimal-imports" + , "packunused" + ] + + , P.linebreak, P.hardline , P.text "Note:" P.<+> P.align (para $ "The 'cabal configure' command above only tests the default package configuration. " ++ "You might need to repeat the process with different flags added to the 'cabal configure' step " ++ @@ -77,6 +88,32 @@ helpHeader = "packunused " ++ showVersion version ++ " (using Cabal "++ showVersion cabalVersion ++ ")" +getInstalledPackageInfos :: [(UnitId, PackageIdentifier)] -> PackageIndex InstalledPackageInfo -> [InstalledPackageInfo] +getInstalledPackageInfos pkgs ipkgs = + [ ipi + | (ipkgid, _) <- pkgs + , not (isInPlacePackage ipkgid) + , Just ipi <- [lookupUnitId ipkgs ipkgid] + ] + where + isInPlacePackage :: UnitId -> Bool + isInPlacePackage (SimpleUnitId (ComponentId comp)) = + "-inplace" `isSuffixOf` comp + +chooseDistPref :: Bool -> IO String +chooseDistPref useStack = do + if useStack + then takeWhile (/= '\n') <$> readProcess "stack" (words "path --dist-dir") "" + else return "dist" + +getLbi :: Bool -> FilePath -> IO LocalBuildInfo +getLbi useStack distPref = either explainError id <$> tryGetPersistBuildConfig distPref + where + explainError :: ConfigStateFileError -> a + explainError x@ConfigStateFileBadVersion{} | useStack = stackExplanation x + explainError x = error ("Error: " ++ show x) + stackExplanation x = error ("Error: " ++ show x ++ "\n\nYou can probably fix this by running:\n stack setup --upgrade-cabal") + main :: IO () main = do Opts {..} <- execParser $ @@ -87,14 +124,16 @@ -- print opts' + useStack <- findRecursive "stack.yaml" + distPref <- chooseDistPref useStack + lbiExists <- doesFileExist (localBuildInfoFile distPref) unless lbiExists $ do putStrLn "*ERROR* package not properly configured yet or not in top-level CABAL project folder; see --help for more details" exitFailure lbiMTime <- getModificationTime (localBuildInfoFile distPref) - lbi <- getPersistBuildConfig distPref - + lbi <- getLbi useStack distPref -- minory sanity checking case pkgDescrFile lbi of @@ -157,22 +196,14 @@ , (m,_) <- imps ] - pkgs = componentPackageDeps clbi - - ipinfos = [ fromMaybe (error (show ipkgid)) $ lookupInstalledPackageId ipkgs ipkgid - | (ipkgid@(InstalledPackageId i), _) <- pkgs - , not ("-inplace" `isSuffixOf` i) - ] + ipinfos = getInstalledPackageInfos (componentPackageDeps clbi) ipkgs (ignored, unignored) = partition (\x -> display (pkgName $ packageId x) `elem` ignoredPackages) ipinfos - unused = [ installedPackageId ipinfo + unused :: [UnitId] + unused = [ installedUnitId ipinfo | ipinfo <- unignored -#if MIN_VERSION_Cabal(1,21,0) , let expmods = map exposedName $ exposedModules ipinfo -#else - , let expmods = exposedModules ipinfo -#endif , not (any (`elem` allmods) expmods) ] @@ -213,8 +244,6 @@ whenM (not <$> readIORef ok) exitFailure where - distPref = "./dist" - compIsLib CLib {} = True compIsLib _ = False @@ -242,11 +271,7 @@ return files -#if MIN_VERSION_Cabal(1,18,0) compBuildOrder = map fst . allComponentsInBuildOrder -#else - withAllComponentsInBuildOrder = withComponentsLBI -#endif componentNameAndModules :: Bool -> Component -> (String, String, [ModuleName]) componentNameAndModules addMainMod c = (n, n2, m) @@ -261,10 +286,6 @@ mainModName = MN.fromString "Main" -#if !MIN_VERSION_Cabal(1,16,0) - componentBuildInfo = foldComponent PD.libBuildInfo PD.buildInfo PD.testBuildInfo PD.benchmarkBuildInfo -#endif - putHeading :: String -> IO () putHeading s = do putStrLn s @@ -281,18 +302,25 @@ contents <- readFile (outDir fn) case parseImportsFile contents of - (H.ParseOk (H.Module _ _ _ _ _ imps _)) -> do + (H.ParseOk (H.Module _ _ _ imps _)) -> do let imps' = [ (MN.fromString mn, extractSpecs (H.importSpecs imp)) - | imp <- imps, let H.ModuleName mn = H.importModule imp ] + | imp <- imps, let H.ModuleName _ mn = H.importModule imp ] return (m, imps') + (H.ParseOk (H.XmlPage _ _ _ _ _ _ _)) -> do + putStrLn "*ERROR* .imports file is invalid file type" + exitFailure + (H.ParseOk (H.XmlHybrid _ _ _ _ _ _ _ _ _)) -> do + putStrLn "*ERROR* .imports file is invalid file type" + exitFailure H.ParseFailed loc msg -> do putStrLn "*ERROR* failed to parse .imports file" putStrLn $ H.prettyPrint loc ++ ": " ++ msg exitFailure where - extractSpecs (Just (False, impspecs)) = map H.prettyPrint impspecs + extractSpecs :: Maybe (H.ImportSpecList s) -> [String] + extractSpecs (Just (H.ImportSpecList _ _ impspecs)) = map H.prettyPrint impspecs extractSpecs _ = error "unexpected import specs" parseImportsFile = H.parseFileContentsWithMode (H.defaultParseMode { H.extensions = exts, H.parseFilename = outDir fn }) . stripExplicitNamespaces . stripSafe @@ -301,12 +329,24 @@ stripExplicitNamespaces = unwords . splitOn " type " stripSafe = unwords . splitOn " safe " -#if MIN_VERSION_haskell_src_exts(1,14,0) exts = map H.EnableExtension [ H.MagicHash, H.PackageImports, H.CPP, H.TypeOperators, H.TypeFamilies {- , H.ExplicitNamespaces -} ] -#else - exts = [ H.MagicHash, H.PackageImports, H.CPP, H.TypeOperators, H.TypeFamilies ] -#endif +-- | Find if a file exists in the current directory or any of its +-- parents. +findRecursive :: FilePath -> IO Bool +findRecursive f = do + dir <- getCurrentDirectory + go dir + where + go dir = do + exists <- doesFileExist (dir f) + if exists + then return exists + else + let parent = takeDirectory dir + in if parent == dir + then return False + else go parent whenM :: Monad m => m Bool -> m () -> m () whenM test = (test >>=) . flip when