diff --git a/app/main.hs b/app/main.hs --- a/app/main.hs +++ b/app/main.hs @@ -40,9 +40,10 @@ main :: IO () main = do Opts {..} <- parseArgs + packages <- parseStackYaml optsStackYamlFile optsPackages - dependencyByModule <- liftIO $ getDependencyByModule optsStackYamlFile packages + dependencyByModule <- liftIO $ getDependencyByModule packages code <- flip execStateT ExitSuccess $ for_ packages $ \T.Package {..} -> do baseUsedDependencies <- fmap mconcat . for packageCompilables $ \compilable@T.Compilable {..} -> do usedDependencies <- liftIO $ getCompilableUsedDependencies dependencyByModule compilable diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,12 +1,13 @@ name: prune-juice -version: '0.3' -maintainer: Dan Fithian +version: '0.4' +maintainer: Dan Fithian license: MIT copyright: 2020 Dan Fithian category: Development synopsis: 'Prune unused Haskell dependencies' -description: 'Prune unused Haskell dependencies from a Stack/Hpack project' +description: 'Prune unused Haskell dependencies from a Stack and Hpack project - see README at ' +github: dfithian/prune-juice ghc-options: - -Wall @@ -57,8 +58,8 @@ - hpack - megaparsec - mtl + - process - text - - turtle - yaml extra-source-files: diff --git a/prune-juice.cabal b/prune-juice.cabal --- a/prune-juice.cabal +++ b/prune-juice.cabal @@ -4,14 +4,16 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 2098da5b836361cc72fe580deae5195ff8f783009872b7361e27bf4b2707ddf4 +-- hash: 84bd7f2d1d9b3ef604802184fadc9163327ac0f260b93b167a9dd6061ec492fb name: prune-juice -version: 0.3 +version: 0.4 synopsis: Prune unused Haskell dependencies -description: Prune unused Haskell dependencies from a Stack/Hpack project +description: Prune unused Haskell dependencies from a Stack and Hpack project - see README at category: Development -maintainer: Dan Fithian +homepage: https://github.com/dfithian/prune-juice#readme +bug-reports: https://github.com/dfithian/prune-juice/issues +maintainer: Dan Fithian copyright: 2020 Dan Fithian license: MIT license-file: LICENSE @@ -20,6 +22,10 @@ stack.yaml package.yaml +source-repository head + type: git + location: https://github.com/dfithian/prune-juice + library exposed-modules: Data.Prune.Dependency @@ -42,8 +48,8 @@ , hpack , megaparsec , mtl + , process , text - , turtle , yaml default-language: Haskell2010 @@ -66,9 +72,9 @@ , megaparsec , mtl , optparse-applicative + , process , prune-juice , text - , turtle , yaml default-language: Haskell2010 @@ -95,8 +101,8 @@ , hspec , megaparsec , mtl + , process , prune-juice , text - , turtle , yaml default-language: Haskell2010 diff --git a/src/Data/Prune/Dependency.hs b/src/Data/Prune/Dependency.hs --- a/src/Data/Prune/Dependency.hs +++ b/src/Data/Prune/Dependency.hs @@ -1,53 +1,33 @@ -- |Load dependencies for a project using `ghc-pkg`. module Data.Prune.Dependency where -import Prelude hiding (words) +import Prelude hiding (unwords, words) -import Data.Foldable (find) import Data.Map (Map) -import Data.Maybe (mapMaybe) -import Data.Text (Text, isPrefixOf, pack, strip, unpack, words) -import Data.Traversable (for) -import System.Exit (ExitCode(ExitFailure, ExitSuccess)) -import Turtle (shellStrict) +import Data.Set (Set) +import Data.Text (Text, pack, splitOn, strip, unpack, unwords, words) +import System.Process (readProcess) import qualified Data.Map as Map import qualified Data.Set as Set -import Data.Prune.ImportParser (parseExposedModules) +import Data.Prune.ImportParser (parseDependencyName, parseExposedModules) import qualified Data.Prune.Types as T --- |Run a shell command or exit if it fails. -runOrFail :: Text -> IO Text -runOrFail cmd = shellStrict cmd mempty >>= \case - (ExitSuccess, out) -> pure out - (ExitFailure _, out) -> fail . unpack $ "Failed to \"" <> cmd <> "\" due to " <> out +parsePkg :: Text -> IO (T.DependencyName, Set T.ModuleName) +parsePkg s = do + dependencyName <- parseDependencyName . unpack . unwords . dropWhile (not . (==) "name:") . words . strip $ s + moduleNames <- parseExposedModules . unpack . unwords . dropWhile (not . (==) "exposed-modules:") . words . strip $ s + pure (dependencyName, moduleNames) -- |For the dependencies listed in the specified packages, load `ghc-pkg` and inspect the `exposed-modules` field. -- Return a map of module to dependency name. -getDependencyByModule :: FilePath -> [T.Package] -> IO (Map T.ModuleName T.DependencyName) -getDependencyByModule stackYamlFile packages = do +getDependencyByModule :: [T.Package] -> IO (Map T.ModuleName T.DependencyName) +getDependencyByModule packages = do let allDependencies = foldMap T.packageBaseDependencies packages <> foldMap T.compilableDependencies (foldMap T.packageCompilables packages) - tupleDependency x = (, x) <$> find (\d -> isPrefixOf (T.unDependencyName d) x) allDependencies - compilerBin <- strip <$> runOrFail ("stack --stack-yaml " <> pack stackYamlFile <> " path --compiler-bin") - snapshotPkgDb <- strip <$> runOrFail ("stack --stack-yaml " <> pack stackYamlFile <> " path --snapshot-pkg-db") - globalPkgDb <- strip <$> runOrFail ("stack --stack-yaml " <> pack stackYamlFile <> " path --global-pkg-db") - localPkgDb <- strip <$> runOrFail ("stack --stack-yaml " <> pack stackYamlFile <> " path --local-pkg-db") - let snapshotGhcPkg = compilerBin <> "/ghc-pkg --package-db " <> snapshotPkgDb - globalGhcPkg = compilerBin <> "/ghc-pkg --package-db " <> globalPkgDb - localGhcPkg = compilerBin <> "/ghc-pkg --package-db " <> localPkgDb - snapshotPkgs <- mapMaybe tupleDependency . words . strip - <$> runOrFail (snapshotGhcPkg <> " list --simple-output") - globalPkgs <- mapMaybe tupleDependency . words . strip - <$> runOrFail (globalGhcPkg <> " list --simple-output") - localPkgs <- mapMaybe tupleDependency . words . strip - <$> runOrFail (localGhcPkg <> " list --simple-output") - snapshotDependencyByModule <- fmap mconcat . for snapshotPkgs $ \(dependencyName, pkg) -> do - moduleNames <- parseExposedModules . unpack . strip =<< runOrFail (snapshotGhcPkg <> " field " <> pkg <> " exposed-modules") - pure . Map.fromList . map (, dependencyName) . Set.toList $ moduleNames - globalDependencyByModule <- fmap mconcat . for globalPkgs $ \(dependencyName, pkg) -> do - moduleNames <- parseExposedModules . unpack . strip =<< runOrFail (globalGhcPkg <> " field " <> pkg <> " exposed-modules") - pure . Map.fromList . map (, dependencyName) . Set.toList $ moduleNames - localDependencyByModule <- fmap mconcat . for localPkgs $ \(dependencyName, pkg) -> do - moduleNames <- parseExposedModules . unpack . strip =<< runOrFail (localGhcPkg <> " field " <> pkg <> " exposed-modules") - pure . Map.fromList . map (, dependencyName) . Set.toList $ moduleNames - pure $ snapshotDependencyByModule <> globalDependencyByModule <> localDependencyByModule + rawPkgs <- readProcess "stack" ["exec", "ghc-pkg", "dump"] "" + allPkgs <- traverse parsePkg . splitOn "\n---\n" . pack $ rawPkgs + pure + . Map.fromList + . concatMap (\(dependencyName, moduleNames) -> (, dependencyName) <$> Set.toList moduleNames) + . filter (flip Set.member allDependencies . fst) + $ allPkgs diff --git a/src/Data/Prune/ImportParser.hs b/src/Data/Prune/ImportParser.hs --- a/src/Data/Prune/ImportParser.hs +++ b/src/Data/Prune/ImportParser.hs @@ -47,6 +47,10 @@ *> optional (void (padded (quoted pkgName)) *> space) *> (T.ModuleName . pack <$> (symbol <* space)) +dependencyName :: Parser T.DependencyName +dependencyName = void (string "name:") *> space + *> (T.DependencyName . pack <$> pkgName) + exposedModules :: Parser (Set T.ModuleName) exposedModules = void (string "exposed-modules:") *> space *> (Set.fromList <$> some (T.ModuleName . pack <$> symbol)) @@ -56,6 +60,10 @@ parseFileImports fp = do either (fail . ("Failed to parse imports due to " <>) . show) (pure . Set.fromList) . traverse (parse oneImport fp) . filter (isPrefixOf "import ") . lines =<< readFile fp + +-- |Parse name from the `ghc-pkg` field description. +parseDependencyName :: String -> IO T.DependencyName +parseDependencyName input = either (\e -> fail $ "Failed to parse name due to " <> show e <> " original input " <> input) pure $ parse dependencyName "" input -- |Parse exposed modules from the `ghc-pkg` field description. parseExposedModules :: String -> IO (Set T.ModuleName) diff --git a/test/Data/Prune/ImportParserSpec.hs b/test/Data/Prune/ImportParserSpec.hs --- a/test/Data/Prune/ImportParserSpec.hs +++ b/test/Data/Prune/ImportParserSpec.hs @@ -28,6 +28,9 @@ it "should parse something complicated" $ do parse oneImport "" "import qualified \"foobar\" Foo.Bar as Baz (foo, bar) " `shouldBe` Right (T.ModuleName "Foo.Bar") + it "should parse dependency name" $ do + parse dependencyName "" "name: foo-bar" `shouldBe` Right (T.DependencyName "foo-bar") + it "should parse exposed modules - single line" $ do parse exposedModules "" "exposed-modules: Hpack Hpack.Config Hpack.Render Hpack.Yaml" `shouldBe` Right (Set.fromList [T.ModuleName "Hpack", T.ModuleName "Hpack.Config", T.ModuleName "Hpack.Render", T.ModuleName "Hpack.Yaml"])