packages feed

prune-juice 0.4 → 0.5

raw patch · 14 files changed

+343/−162 lines, 14 filesdep +Cabaldep +cabal-install-parsersdep +monad-loggerdep −hpack

Dependencies added: Cabal, cabal-install-parsers, monad-logger

Dependencies removed: hpack

Files

app/main.hs view
@@ -1,62 +1,105 @@ import Prelude -import Control.Applicative (many)-import Control.Monad (unless)+import Control.Applicative ((<|>), many)+import Control.Monad (unless, when) import Control.Monad.IO.Class (liftIO)+import Control.Monad.Logger (defaultOutput, runLoggingT) import Control.Monad.State (execStateT, put) import Data.Foldable (for_, traverse_)+import Data.Set (Set) import Data.Text (Text, pack, unpack) import Data.Traversable (for) import System.Exit (ExitCode(ExitFailure, ExitSuccess), exitWith)+import System.FilePath.Posix ((</>))+import System.IO (stdout) import qualified Data.Set as Set import qualified Options.Applicative as Opt +import Data.Prune.Cabal (findCabalFiles, parseCabalFiles, parseCabalProjectFile) import Data.Prune.Dependency (getDependencyByModule) import Data.Prune.ImportParser (getCompilableUsedDependencies)-import Data.Prune.Package (parseStackYaml)+import Data.Prune.Stack (parseStackYaml) import qualified Data.Prune.Types as T  data Opts = Opts-  { optsStackYamlFile :: FilePath+  { optsProjectRoot :: FilePath+  , optsNoDefaultIgnore :: Bool+  , optsNoIgnoreSelf :: Bool+  , optsExtraIgnoreList :: [T.DependencyName]   , optsPackages :: [Text]+  , optsVerbose :: Bool   } +defaultIgnoreList :: Set T.DependencyName+defaultIgnoreList = Set.fromList+  [ T.DependencyName "base" -- ignore base because it's needed for info modules etc+  , T.DependencyName "hspec" -- ignore because some packages use hspec discovery+  , T.DependencyName "tasty" -- ignore because some packages use tasty discovery+  ]+ parseArgs :: IO Opts-parseArgs = Opt.execParser (Opt.info (Opt.helper <*> parser) $ Opt.progDesc "Prune a Stack project's dependencies")+parseArgs = Opt.execParser (Opt.info (Opt.helper <*> parser) $ Opt.progDesc "Prune a Haskell project's dependencies")   where     parser = Opts       <$> Opt.strOption (-        Opt.long "stack-yaml-file"-          <> Opt.metavar "STACK_YAML_FILE"-          <> Opt.help "Location of stack.yaml"-          <> Opt.value "stack.yaml"+        Opt.long "project-root"+          <> Opt.metavar "PROJECT_ROOT"+          <> Opt.help "Project root"+          <> Opt.value "."           <> Opt.showDefault )+      <*> Opt.switch (+        Opt.long "no-default-ignore"+          <> Opt.help ("Don't use the default ignore list (" <> show (Set.toList defaultIgnoreList) <> ")") )+      <*> Opt.switch (+        Opt.long "no-ignore-self"+          <> Opt.help "Error if an executable doesn't use the library it's defined with" )+      <*> many ( T.DependencyName . pack <$> Opt.strOption (+        Opt.long "extra-ignore"+          <> Opt.metavar "EXTRA_IGNORE"+          <> Opt.help "Dependencies(s) to ignore in addition to the default ignore list" ) )       <*> many ( pack <$> Opt.strOption (         Opt.long "package"           <> Opt.metavar "PACKAGE"           <> Opt.help "Package name(s)" ) )-+      <*> Opt.switch (+        Opt.long "verbose"+          <> Opt.help "Turn on verbose logging"+      )  main :: IO () main = do   Opts {..} <- parseArgs -  packages <- parseStackYaml optsStackYamlFile optsPackages+  let ignoreList = Set.fromList optsExtraIgnoreList <> if optsNoDefaultIgnore then mempty else defaultIgnoreList+      logger ma = runLoggingT ma $ case optsVerbose of+        True -> defaultOutput stdout+        False -> \_ _ _ _ -> pure () -  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-      let (baseUsedDependencies, otherUsedDependencies) = Set.partition (flip Set.member packageBaseDependencies) usedDependencies-          otherUnusedDependencies = Set.difference compilableDependencies otherUsedDependencies-      unless (Set.null otherUnusedDependencies) $ do-        liftIO . putStrLn . unpack $ "Some unused dependencies for " <> pack (show compilableType) <> " " <> T.unCompilableName compilableName <> " in package " <> packageName-        traverse_ (liftIO . putStrLn . unpack . ("  " <>) . T.unDependencyName) $ Set.toList otherUnusedDependencies+  (buildSystem, packageDirs) <- parseStackYaml (optsProjectRoot </> "stack.yaml")+    <|> parseCabalProjectFile (optsProjectRoot </> "cabal.project")+    <|> findCabalFiles optsProjectRoot+  putStrLn $ "Using build system " <> show buildSystem+  putStrLn $ "Using ignore list " <> show (Set.toList ignoreList)+  when (buildSystem `elem` [T.CabalProject, T.Cabal]) $+    putStrLn $ "[WARNING] Cabal is not supported"+  code <- logger $ do+    packages <- parseCabalFiles packageDirs ignoreList optsPackages++    dependencyByModule <- liftIO $ getDependencyByModule buildSystem packages+    flip execStateT ExitSuccess $ for_ packages $ \T.Package {..} -> do+      let addSelf = if optsNoIgnoreSelf then id else Set.insert (T.DependencyName packageName)+      baseUsedDependencies <- fmap mconcat . for packageCompilables $ \compilable@T.Compilable {..} -> do+        usedDependencies <- addSelf <$> getCompilableUsedDependencies dependencyByModule compilable+        let (baseUsedDependencies, otherUsedDependencies) = Set.partition (flip Set.member packageBaseDependencies) usedDependencies+            otherUnusedDependencies = Set.difference compilableDependencies otherUsedDependencies+        unless (Set.null otherUnusedDependencies) $ do+          liftIO . putStrLn . unpack $ "Some unused dependencies for " <> pack (show compilableType) <> " " <> T.unCompilableName compilableName <> " in package " <> packageName+          traverse_ (liftIO . putStrLn . unpack . ("  " <>) . T.unDependencyName) $ Set.toList otherUnusedDependencies+          put $ ExitFailure 1+        pure baseUsedDependencies+      let baseUnusedDependencies = Set.difference packageBaseDependencies baseUsedDependencies+      unless (Set.null baseUnusedDependencies) $ do+        liftIO . putStrLn . unpack $ "Some unused base dependencies for package " <> packageName+        liftIO . traverse_ (putStrLn . unpack . ("  " <>) . T.unDependencyName) $ Set.toList baseUnusedDependencies         put $ ExitFailure 1-      pure baseUsedDependencies-    let baseUnusedDependencies = Set.difference packageBaseDependencies baseUsedDependencies-    unless (Set.null baseUnusedDependencies) $ do-      liftIO . putStrLn . unpack $ "Some unused base dependencies for package " <> packageName-      liftIO . traverse_ (putStrLn . unpack . ("  " <>) . T.unDependencyName) $ Set.toList baseUnusedDependencies-      put $ ExitFailure 1   exitWith code
package.yaml view
@@ -1,12 +1,12 @@ name: prune-juice -version: '0.4'+version: '0.5' 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 and Hpack project - see README at <https://github.com/dfithian/prune-juice#readme>'+description: 'Prune unused Haskell dependencies - see README at <https://github.com/dfithian/prune-juice#readme>' github: dfithian/prune-juice  ghc-options:@@ -52,11 +52,13 @@   - aeson   - base < 5.0   - bytestring+  - Cabal+  - cabal-install-parsers   - containers   - directory   - filepath-  - hpack   - megaparsec+  - monad-logger   - mtl   - process   - text
prune-juice.cabal view
@@ -4,12 +4,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: 84bd7f2d1d9b3ef604802184fadc9163327ac0f260b93b167a9dd6061ec492fb+-- hash: abe3414c7a1bb62701a300318224b85d8df88e1c508cb6ed260294ea435e560d  name:           prune-juice-version:        0.4+version:        0.5 synopsis:       Prune unused Haskell dependencies-description:    Prune unused Haskell dependencies from a Stack and Hpack project - see README at <https://github.com/dfithian/prune-juice#readme>+description:    Prune unused Haskell dependencies - see README at <https://github.com/dfithian/prune-juice#readme> category:       Development homepage:       https://github.com/dfithian/prune-juice#readme bug-reports:    https://github.com/dfithian/prune-juice/issues@@ -28,9 +28,11 @@  library   exposed-modules:+      Data.Prune.Cabal       Data.Prune.Dependency+      Data.Prune.File       Data.Prune.ImportParser-      Data.Prune.Package+      Data.Prune.Stack       Data.Prune.Types   other-modules:       Paths_prune_juice@@ -39,14 +41,16 @@   default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric DerivingStrategies DerivingVia EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns   ghc-options: -Wall -fwarn-tabs -fwarn-redundant-constraints -Wincomplete-uni-patterns -eventlog   build-depends:-      aeson+      Cabal+    , aeson     , base <5.0     , bytestring+    , cabal-install-parsers     , containers     , directory     , filepath-    , hpack     , megaparsec+    , monad-logger     , mtl     , process     , text@@ -62,14 +66,16 @@   default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric DerivingStrategies DerivingVia EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns   ghc-options: -Wall -fwarn-tabs -fwarn-redundant-constraints -Wincomplete-uni-patterns -eventlog   build-depends:-      aeson+      Cabal+    , aeson     , base <5.0     , bytestring+    , cabal-install-parsers     , containers     , directory     , filepath-    , hpack     , megaparsec+    , monad-logger     , mtl     , optparse-applicative     , process@@ -82,24 +88,26 @@   type: exitcode-stdio-1.0   main-is: main.hs   other-modules:+      Data.Prune.CabalSpec       Data.Prune.ImportParserSpec-      Data.Prune.PackageSpec       Paths_prune_juice   hs-source-dirs:       test   default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveGeneric DerivingStrategies DerivingVia EmptyDataDecls FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns   ghc-options: -Wall -fwarn-tabs -fwarn-redundant-constraints -Wincomplete-uni-patterns -eventlog   build-depends:-      aeson+      Cabal+    , aeson     , base <5.0     , bytestring+    , cabal-install-parsers     , containers     , directory     , file-path-th     , filepath-    , hpack     , hspec     , megaparsec+    , monad-logger     , mtl     , process     , prune-juice
+ src/Data/Prune/Cabal.hs view
@@ -0,0 +1,144 @@+module Data.Prune.Cabal where++import Prelude++import Cabal.Project (prjPackages, readProject)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Logger (MonadLogger, logInfo)+import Data.Maybe (maybeToList)+import Data.Prune.File (listFilesRecursive)+import Data.Set (Set)+import Data.Text (Text, pack)+import Data.Traversable (for)+import Distribution.PackageDescription.Parsec (readGenericPackageDescription)+import Distribution.Types.Benchmark (Benchmark)+import Distribution.Types.BuildInfo (BuildInfo)+import Distribution.Types.CondTree (CondTree)+import Distribution.Types.Dependency (Dependency)+import Distribution.Types.Executable (Executable)+import Distribution.Types.Library (Library)+import Distribution.Types.TestSuite (TestSuite)+import System.Directory (listDirectory)+import System.FilePath.Posix ((</>), isExtensionOf, takeDirectory, takeFileName)+import qualified Data.Set as Set+import qualified Distribution.Types.Benchmark as Benchmark+import qualified Distribution.Types.BenchmarkInterface as BenchmarkInterface+import qualified Distribution.Types.BuildInfo as BuildInfo+import qualified Distribution.Types.CondTree as CondTree+import qualified Distribution.Types.Dependency as Dependency+import qualified Distribution.Types.Executable as Executable+import qualified Distribution.Types.GenericPackageDescription as GenericPackageDescription+import qualified Distribution.Types.Library as Library+import qualified Distribution.Types.PackageDescription as PackageDescription+import qualified Distribution.Types.PackageId as PackageId+import qualified Distribution.Types.PackageName as PackageName+import qualified Distribution.Types.TestSuite as TestSuite+import qualified Distribution.Types.TestSuiteInterface as TestSuiteInterface+import qualified Distribution.Types.UnqualComponentName as UnqualComponentName+import qualified Distribution.Verbosity as Verbosity++import qualified Data.Prune.Types as T++-- |Get the dependencies for a thing to compile.+getDependencyNames :: Set T.DependencyName -> [Dependency] -> Set T.DependencyName+getDependencyNames ignores = flip Set.difference ignores . Set.fromList . map (T.DependencyName . pack.  PackageName.unPackageName . Dependency.depPkgName)++-- |Get the Haskell source files to compile.+getSourceFiles :: FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)+getSourceFiles fp mainMay buildInfo = do+  let hsSourceDirs = BuildInfo.hsSourceDirs buildInfo+  allFiles <- case null hsSourceDirs of+    True -> Set.filter (flip elem (takeFileName <$> maybeToList mainMay) . takeFileName) <$> listFilesRecursive fp+    False -> fmap mconcat . for hsSourceDirs $ \dir -> listFilesRecursive $ fp </> dir+  pure $ Set.filter (\fp2 -> isExtensionOf "hs" fp2 || isExtensionOf "lhs" fp2) allFiles++-- |Parse a library to compile.+getLibraryCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Library -> IO T.Compilable+getLibraryCompilable fp ignores name tree = do+  let compilableName = T.CompilableName name+  sourceFiles <- getSourceFiles fp Nothing . Library.libBuildInfo . CondTree.condTreeData $ tree+  pure $ T.Compilable compilableName T.CompilableTypeLibrary (getDependencyNames ignores $ CondTree.condTreeConstraints tree) sourceFiles++-- |Parse an executable to compile.+getExecutableCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Executable -> IO T.Compilable+getExecutableCompilable fp ignores name tree = do+  let compilableName = T.CompilableName name+      mainMay = Just . Executable.modulePath . CondTree.condTreeData $ tree+  sourceFiles <- getSourceFiles fp mainMay . Executable.buildInfo . CondTree.condTreeData $ tree+  pure $ T.Compilable compilableName T.CompilableTypeExecutable (getDependencyNames ignores $ CondTree.condTreeConstraints tree) sourceFiles++-- |Parse a test to compile.+getTestCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] TestSuite -> IO T.Compilable+getTestCompilable fp ignores name tree = do+  let compilableName = T.CompilableName name+      mainMay = case TestSuite.testInterface $ CondTree.condTreeData tree of+        TestSuiteInterface.TestSuiteExeV10 _ exe -> Just exe+        TestSuiteInterface.TestSuiteLibV09 _ _ -> Nothing+        TestSuiteInterface.TestSuiteUnsupported _ -> Nothing+  sourceFiles <- getSourceFiles fp mainMay . TestSuite.testBuildInfo . CondTree.condTreeData $ tree+  pure $ T.Compilable compilableName T.CompilableTypeTest (getDependencyNames ignores $ CondTree.condTreeConstraints tree) sourceFiles++-- |Parse a benchmark to compile.+getBenchmarkCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Benchmark -> IO T.Compilable+getBenchmarkCompilable fp ignores name tree = do+  let compilableName = T.CompilableName name+      mainMay = case Benchmark.benchmarkInterface $ CondTree.condTreeData tree of+        BenchmarkInterface.BenchmarkExeV10 _ exe -> Just exe+        BenchmarkInterface.BenchmarkUnsupported _ -> Nothing+  sourceFiles <- getSourceFiles fp mainMay . Benchmark.benchmarkBuildInfo . CondTree.condTreeData $ tree+  pure $ T.Compilable compilableName T.CompilableTypeBenchmark (getDependencyNames ignores $ CondTree.condTreeConstraints tree) sourceFiles++headMay :: [a] -> Maybe a+headMay = \case+  [] -> Nothing+  x:_ -> Just x++-- |Parse a single cabal file.+parseCabalFile :: FilePath -> Set T.DependencyName -> IO T.Package+parseCabalFile fp ignores = do+  cabalFile <- maybe (fail $ "No .cabal file found in " <> fp) pure . headMay . filter (isExtensionOf "cabal") =<< listDirectory fp+  genericPackageDescription <- readGenericPackageDescription Verbosity.silent $ fp </> cabalFile+  let baseDependencies = case GenericPackageDescription.condLibrary genericPackageDescription of+        Just library -> getDependencyNames ignores $ CondTree.condTreeConstraints library+        -- if no library, use set intersection to figure out the common dependencies and use that as the base+        Nothing ->+          let allCabalDependencies :: [Set T.DependencyName]+              allCabalDependencies = fmap (getDependencyNames ignores) . mconcat $+                [ CondTree.condTreeConstraints . snd <$> GenericPackageDescription.condSubLibraries genericPackageDescription+                , CondTree.condTreeConstraints . snd <$> GenericPackageDescription.condExecutables genericPackageDescription+                , CondTree.condTreeConstraints . snd <$> GenericPackageDescription.condTestSuites genericPackageDescription+                , CondTree.condTreeConstraints . snd <$> GenericPackageDescription.condBenchmarks genericPackageDescription+                ]+          in case allCabalDependencies of+            [] -> mempty+            x:xs -> foldr Set.intersection x xs+      packageDescription = GenericPackageDescription.packageDescription genericPackageDescription+      packageName = pack . PackageName.unPackageName . PackageId.pkgName . PackageDescription.package $ packageDescription+  libraries         <- traverse (getLibraryCompilable    fp (ignores <> baseDependencies) packageName) . maybeToList . GenericPackageDescription.condLibrary $ genericPackageDescription+  internalLibraries <- traverse (getLibraryCompilable    fp (ignores <> baseDependencies) <$> pack . UnqualComponentName.unUnqualComponentName . fst <*> snd) . GenericPackageDescription.condSubLibraries $ genericPackageDescription+  executables       <- traverse (getExecutableCompilable fp (ignores <> baseDependencies) <$> pack . UnqualComponentName.unUnqualComponentName . fst <*> snd) . GenericPackageDescription.condExecutables $ genericPackageDescription+  tests             <- traverse (getTestCompilable       fp (ignores <> baseDependencies) <$> pack . UnqualComponentName.unUnqualComponentName . fst <*> snd) . GenericPackageDescription.condTestSuites $ genericPackageDescription+  benchmarks        <- traverse (getBenchmarkCompilable  fp (ignores <> baseDependencies) <$> pack . UnqualComponentName.unUnqualComponentName . fst <*> snd) . GenericPackageDescription.condBenchmarks $ genericPackageDescription+  pure T.Package+    { packageName = packageName+    , packageBaseDependencies = baseDependencies+    , packageCompilables = libraries <> internalLibraries <> executables <> tests <> benchmarks+    }++-- |Parse cabal files by file path, filter by explicit package names (if provided), and return the parsed packages.+parseCabalFiles :: (MonadIO m, MonadLogger m) => [FilePath] -> Set T.DependencyName -> [Text] -> m [T.Package]+parseCabalFiles packageDirs ignores packages = do+  rawPackages <- liftIO $ traverse (flip parseCabalFile ignores) packageDirs+  let toReturn = if null packages then rawPackages else filter (flip elem packages . T.packageName) rawPackages+  $logInfo $ "Parsed packages " <> pack (show toReturn)+  pure toReturn++findCabalFiles :: FilePath -> IO (T.BuildSystem, [FilePath])+findCabalFiles projectRoot = do+  (T.Cabal,) . map takeDirectory . filter (isExtensionOf "cabal") . Set.toList <$> listFilesRecursive projectRoot++-- |Parse cabal.project file by file path.+parseCabalProjectFile :: FilePath -> IO (T.BuildSystem, [FilePath])+parseCabalProjectFile cabalProjectFile = do+  project <- readProject cabalProjectFile+  pure (T.CabalProject, takeDirectory . fst <$> prjPackages project)
src/Data/Prune/Dependency.hs view
@@ -21,13 +21,16 @@  -- |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 :: [T.Package] -> IO (Map T.ModuleName T.DependencyName)-getDependencyByModule packages = do+getDependencyByModule :: T.BuildSystem -> [T.Package] -> IO (Map T.ModuleName (Set T.DependencyName))+getDependencyByModule buildSystem packages = do   let allDependencies = foldMap T.packageBaseDependencies packages <> foldMap T.compilableDependencies (foldMap T.packageCompilables packages)-  rawPkgs <- readProcess "stack" ["exec", "ghc-pkg", "dump"] ""+  rawPkgs <- case buildSystem of+    T.Stack -> readProcess "stack" ["exec", "ghc-pkg", "dump"] ""+    T.CabalProject -> readProcess "cabal" ["v2-exec", "ghc-pkg", "dump"] ""+    T.Cabal -> readProcess "cabal" ["v2-exec", "ghc-pkg", "dump"] ""   allPkgs <- traverse parsePkg . splitOn "\n---\n" . pack $ rawPkgs   pure-    . Map.fromList-    . concatMap (\(dependencyName, moduleNames) -> (, dependencyName) <$> Set.toList moduleNames)+    . foldr (\(moduleName, dependencyNames) acc -> Map.insertWith (<>) moduleName dependencyNames acc) mempty+    . concatMap (\(dependencyName, moduleNames) -> (, Set.singleton dependencyName) <$> Set.toList moduleNames)     . filter (flip Set.member allDependencies . fst)     $ allPkgs
+ src/Data/Prune/File.hs view
@@ -0,0 +1,26 @@+module Data.Prune.File where++import Prelude++import Data.Set (Set)+import Data.Traversable (for)+import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)+import System.FilePath.Posix ((</>))+import qualified Data.Set as Set++-- |Recursively list files in a directory, ignoring symlinks.+listFilesRecursive :: FilePath -> IO (Set FilePath)+listFilesRecursive dir = do+  dirs <- listDirectory dir+  fmap mconcat . for dirs $ \case+    -- don't include "hidden" directories, i.e. those that start with a '.'+    '.' : _ -> pure mempty+    fn -> do+      let+        path = if dir == "." then fn else dir </> fn+      isDir <- doesDirectoryExist path+      isSymlink <- pathIsSymbolicLink path+      case (isSymlink, isDir) of+        (True, True) -> pure mempty+        (_, True) -> listFilesRecursive path+        _ -> pure $ Set.singleton path
src/Data/Prune/ImportParser.hs view
@@ -5,8 +5,11 @@  import Control.Applicative ((<|>), optional, some) import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Logger (MonadLogger, logInfo) import Data.List (isPrefixOf) import Data.Map (Map)+import Data.Maybe (fromMaybe) import Data.Set (Set) import Data.Text (pack) import Data.Traversable (for)@@ -73,14 +76,17 @@     else either (\e -> fail $ "Failed to parse exposed modules due to " <> show e <> " original input " <> input) pure $ parse exposedModules "" input  -- |Get the dependencies used by a list of modules imported by a Haskell source file.-getUsedDependencies :: Map T.ModuleName T.DependencyName -> Set T.ModuleName -> Set T.DependencyName+getUsedDependencies :: Map T.ModuleName (Set T.DependencyName) -> Set T.ModuleName -> Set T.DependencyName getUsedDependencies dependencyByModule = foldr go mempty . Set.toList   where-    go next acc = acc <> maybe mempty Set.singleton (Map.lookup next dependencyByModule)+    go next acc = acc <> fromMaybe mempty (Map.lookup next dependencyByModule)  -- |Get the dependencies used by a thing to compile by (1) parsing each source file's imports, (2) getting the -- dependencies each of those files use, and (3) smooshing all the dependencies together to return.-getCompilableUsedDependencies :: Map T.ModuleName T.DependencyName -> T.Compilable -> IO (Set T.DependencyName)+getCompilableUsedDependencies :: (MonadIO m, MonadLogger m) => Map T.ModuleName (Set T.DependencyName) -> T.Compilable -> m (Set T.DependencyName) getCompilableUsedDependencies dependencyByModule T.Compilable {..} = fmap mconcat . for (Set.toList compilableFiles) $ \fp -> do-  moduleNames <- parseFileImports fp-  pure $ getUsedDependencies dependencyByModule moduleNames+  moduleNames <- liftIO $ parseFileImports fp+  $logInfo $ "Got module names for " <> pack fp <> ": " <> pack (show moduleNames)+  let usedDependencies = getUsedDependencies dependencyByModule moduleNames+  $logInfo $ "Got dependency names for " <> pack fp <> ": " <> pack (show usedDependencies)+  pure usedDependencies
− src/Data/Prune/Package.hs 
@@ -1,80 +0,0 @@--- |Utilities for package.yaml parsing.-module Data.Prune.Package where--import Prelude--import Data.Map (Map)-import Data.Set (Set)-import Data.Text (Text, pack)-import Data.Traversable (for)-import Hpack.Config-  ( Section, decodeOptionsTarget, decodeResultPackage, defaultDecodeOptions, packageBenchmarks-  , packageConfig, packageExecutables, packageInternalLibraries, packageLibrary, packageName-  , packageTests, readPackageConfig, sectionDependencies, sectionSourceDirs, unDependencies-  )-import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)-import System.FilePath.Posix ((</>), isExtensionOf)-import qualified Data.ByteString as BS-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified Data.Yaml as Yaml--import qualified Data.Prune.Types as T---- |Recursively list files in a directory, ignoring symlinks.-listFilesRecursive :: FilePath -> IO (Set FilePath)-listFilesRecursive dir = do-  dirs <- listDirectory dir-  fmap mconcat . for dirs $ \case-    -- don't include "hidden" directories, i.e. those that start with a '.'-    '.' : _ -> pure mempty-    fn -> do-      let-        path = if dir == "." then fn else dir </> fn-      isDir <- doesDirectoryExist path-      isSymlink <- pathIsSymbolicLink path-      case (isSymlink, isDir) of-        (True, _) -> pure mempty-        (_, True) -> listFilesRecursive path-        _ -> pure $ Set.singleton path---- |Get the dependencies for a thing to compile.-getSectionDependencyNames :: Section a -> Set T.DependencyName-getSectionDependencyNames = Set.fromList . map (T.DependencyName . pack) . Map.keys . unDependencies . sectionDependencies---- |Get the Haskell source files to compile.-getSectionFiles :: FilePath -> Section a -> IO (Set FilePath)-getSectionFiles fp section = fmap mconcat . for (sectionSourceDirs section) $ \dir -> do-  allFiles <- listFilesRecursive $ fp </> dir-  pure $ Set.filter (isExtensionOf "hs") allFiles---- |Parse a thing to compile.-getSectionCompilables :: FilePath -> T.CompilableType -> Set T.DependencyName -> Map String (Section a) -> IO [T.Compilable]-getSectionCompilables fp typ baseDependencies sections = for (Map.toList sections) $ \(name, section) -> do-  sourceFiles <- getSectionFiles fp section-  pure $ T.Compilable (T.CompilableName (pack name)) typ (Set.difference (getSectionDependencyNames section) baseDependencies) sourceFiles---- |Parse a single package.yaml file.-parsePackageYaml :: FilePath -> IO T.Package-parsePackageYaml fp = do-  package <- either fail (pure . decodeResultPackage) =<< readPackageConfig (defaultDecodeOptions { decodeOptionsTarget = fp </> packageConfig })-  let baseDependencies = maybe mempty getSectionDependencyNames $ packageLibrary package-  libraries         <- getSectionCompilables fp T.CompilableTypeLibrary    baseDependencies $ maybe mempty (Map.singleton (packageName package)) $ packageLibrary package-  internalLibraries <- getSectionCompilables fp T.CompilableTypeLibrary    baseDependencies $ packageInternalLibraries package-  executables       <- getSectionCompilables fp T.CompilableTypeExecutable baseDependencies $ packageExecutables package-  tests             <- getSectionCompilables fp T.CompilableTypeTest       baseDependencies $ packageTests package-  benchmarks        <- getSectionCompilables fp T.CompilableTypeBenchmark  baseDependencies $ packageBenchmarks package-  pure T.Package-    { packageName = pack $ packageName package-    , packageBaseDependencies = baseDependencies-    , packageCompilables = libraries <> internalLibraries <> executables <> tests <> benchmarks-    }---- |Parse stack.yaml by file path, filter by explicit package names (if provided), and return the parsed packages.-parseStackYaml :: FilePath -> [Text] -> IO [T.Package]-parseStackYaml stackYamlFile packages = do-  T.StackYaml {..} <- either (fail . ("Couldn't parse stack.yaml due to " <>) . show) pure . Yaml.decodeEither' =<< BS.readFile stackYamlFile-  rawPackages <- traverse parsePackageYaml stackYamlPackages-  if null packages-    then pure rawPackages-    else pure $ filter (flip elem packages . T.packageName) rawPackages
+ src/Data/Prune/Stack.hs view
@@ -0,0 +1,13 @@+module Data.Prune.Stack where++import Prelude++import qualified Data.ByteString as BS+import qualified Data.Yaml as Yaml++import qualified Data.Prune.Types as T++-- |Parse stack.yaml by file path, filter by explicit package names (if provided), and return the parsed packages.+parseStackYaml :: FilePath -> IO (T.BuildSystem, [FilePath])+parseStackYaml stackYamlFile = do+  either (fail . ("Couldn't parse stack.yaml due to " <>) . show) (pure . (T.Stack,) . T.stackYamlPackages) . Yaml.decodeEither' =<< BS.readFile stackYamlFile
src/Data/Prune/Types.hs view
@@ -5,8 +5,11 @@  import Data.Aeson ((.:), FromJSON, parseJSON, withObject) import Data.Set (Set)-import Data.Text (Text)+import Data.Text (Text, unpack) +data BuildSystem = Stack | CabalProject | Cabal+  deriving (Eq, Ord, Show)+ -- |The type of the thing to compile. data CompilableType   = CompilableTypeLibrary@@ -24,15 +27,24 @@  -- |The name of the thing to compile. newtype CompilableName = CompilableName { unCompilableName :: Text }-  deriving (Eq, Ord, Show)+  deriving (Eq, Ord) +instance Show CompilableName where+  show = unpack . unCompilableName+ -- |The name of the dependency as listed in package.yaml data DependencyName = DependencyName { unDependencyName :: Text }-  deriving (Eq, Ord, Show)+  deriving (Eq, Ord) +instance Show DependencyName where+  show = unpack . unDependencyName+ -- |A qualified module name, like `Foo.Bar` data ModuleName = ModuleName { unModuleName :: Text }-  deriving (Eq, Ord, Show)+  deriving (Eq, Ord)++instance Show ModuleName where+  show = unpack . unModuleName  -- |A thing to compile. data Compilable = Compilable
stack.yaml view
@@ -1,3 +1,5 @@ resolver: lts-17.5 packages:   - .+extra-deps:+- cabal-install-parsers-0.3.0.1
+ test/Data/Prune/CabalSpec.hs view
@@ -0,0 +1,28 @@+module Data.Prune.CabalSpec where++import Prelude++import Control.Monad.Logger (runNoLoggingT)+import Data.Foldable (find)+import Data.List (isSuffixOf)+import System.FilePath.TH (fileRelativeToAbsolute)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)+import qualified Data.Set as Set++import qualified Data.Prune.Types as T++-- the module being tested+import Data.Prune.Cabal++spec :: Spec+spec = describe "Data.Prune.Cabal" $ do+  let cabalProjectFile = $(fileRelativeToAbsolute "../../../cabal.project")+  it "parses .cabal files" $ do+    (_, cabalProject) <- parseCabalProjectFile cabalProjectFile+    [T.Package {..}] <- runNoLoggingT $ parseCabalFiles cabalProject mempty []+    packageName `shouldBe` "prune-juice"+    packageBaseDependencies `shouldSatisfy` Set.member (T.DependencyName "base")+    T.Compilable {..} <- maybe (fail "No compilable with the name \"test\"") pure $ find ((==) (T.CompilableName "test") . T.compilableName) packageCompilables+    compilableType `shouldBe` T.CompilableTypeTest+    compilableDependencies `shouldSatisfy` not . Set.null+    compilableFiles `shouldSatisfy` not . Set.null . Set.filter (isSuffixOf "CabalSpec.hs")
− test/Data/Prune/PackageSpec.hs 
@@ -1,26 +0,0 @@-module Data.Prune.PackageSpec where--import Prelude--import Data.Foldable (find)-import Data.List (isSuffixOf)-import System.FilePath.TH (fileRelativeToAbsolute)-import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)-import qualified Data.Set as Set--import qualified Data.Prune.Types as T---- the module being tested-import Data.Prune.Package--spec :: Spec-spec = describe "Data.Prune.Package" $ do-  let stackYamlFile = $(fileRelativeToAbsolute "../../../stack.yaml")-  it "parses stack.yaml" $ do-    [T.Package {..}] <- parseStackYaml stackYamlFile []-    packageName `shouldBe` "prune-juice"-    packageBaseDependencies `shouldSatisfy` Set.member (T.DependencyName "base")-    T.Compilable {..} <- maybe (fail "No compilable with the name \"test\"") pure $ find ((==) (T.CompilableName "test") . T.compilableName) packageCompilables-    compilableType `shouldBe` T.CompilableTypeTest-    compilableDependencies `shouldSatisfy` not . Set.null-    compilableFiles `shouldSatisfy` not . Set.null . Set.filter (isSuffixOf "PackageSpec.hs")
test/main.hs view
@@ -2,10 +2,10 @@  import Test.Hspec (hspec) +import qualified Data.Prune.CabalSpec import qualified Data.Prune.ImportParserSpec-import qualified Data.Prune.PackageSpec  main :: IO () main = hspec $ do+  Data.Prune.CabalSpec.spec   Data.Prune.ImportParserSpec.spec-  Data.Prune.PackageSpec.spec