prune-juice 0.3 → 0.4

raw patch · 6 files changed

+50/−51 lines, 6 filesdep +processdep −turtlePVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependencies removed: turtle

API changes (from Hackage documentation)

Files

• app/main.hs +2/−1
• package.yaml +5/−4
• prune-juice.cabal +13/−7
• src/Data/Prune/Dependency.hs +19/−39
• src/Data/Prune/ImportParser.hs +8/−0
• test/Data/Prune/ImportParserSpec.hs +3/−0

@@ -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

@@ -1,12 +1,13 @@ name: prune-juice -version: '0.3'-maintainer: Dan Fithian+version: '0.4'+maintainer: Dan Fithian <daniel.m.fithian@gmail.com> 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 <https://github.com/dfithian/prune-juice#readme>'+github: dfithian/prune-juice  ghc-options:   - -Wall@@ -57,8 +58,8 @@   - hpack   - megaparsec   - mtl+  - process   - text-  - turtle   - yaml  extra-source-files:

@@ -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 <https://github.com/dfithian/prune-juice#readme> 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 <daniel.m.fithian@gmail.com> 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

@@ -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

@@ -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)

@@ -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"])