diff --git a/prune-juice.cabal b/prune-juice.cabal --- a/prune-juice.cabal +++ b/prune-juice.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c82d607d1298918a330352ff35cee89ea7edd8f5b4321866f33d55b7558eb1c7 +-- hash: 53250a2e99ec4cc00ac7de0c8ed487e525ecf153afaeb50913fa85f53a64e6a1 name: prune-juice -version: 0.1 +version: 0.2 synopsis: Prune unused Haskell dependencies description: Prune unused Haskell dependencies from a Stack/Hpack project category: Development 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,3 +1,4 @@ +-- |Load dependencies for a project using `ghc-pkg`. module Data.Prune.Dependency where import Prelude hiding (words) @@ -15,11 +16,14 @@ import Data.Prune.ImportParser (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 +-- |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 let allDependencies = foldMap T.packageBaseDependencies packages <> foldMap T.compilableDependencies (foldMap T.packageCompilables packages) 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 @@ -1,3 +1,4 @@ +-- |Utilities for parsing imports from Haskell source files. module Data.Prune.ImportParser where import Prelude @@ -50,22 +51,27 @@ exposedModules = void (string "exposed-modules:") *> space *> (Set.fromList <$> some (T.ModuleName . pack <$> symbol)) +-- |Parse a Haskell source file's imports. parseFileImports :: FilePath -> IO (Set T.ModuleName) 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 exposed modules from the `ghc-pkg` field description. parseExposedModules :: String -> IO (Set T.ModuleName) parseExposedModules input = if null input then pure mempty 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 dependencyByModule = foldr go mempty . Set.toList where go next acc = acc <> maybe mempty Set.singleton (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 dependencyByModule T.Compilable {..} = fmap mconcat . for (Set.toList compilableFiles) $ \fp -> do moduleNames <- parseFileImports fp diff --git a/src/Data/Prune/Package.hs b/src/Data/Prune/Package.hs --- a/src/Data/Prune/Package.hs +++ b/src/Data/Prune/Package.hs @@ -1,3 +1,4 @@ +-- |Utilities for package.yaml parsing. module Data.Prune.Package where import Prelude @@ -20,6 +21,7 @@ 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 @@ -36,19 +38,23 @@ (_, 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 }) @@ -64,6 +70,7 @@ , 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 diff --git a/src/Data/Prune/Types.hs b/src/Data/Prune/Types.hs --- a/src/Data/Prune/Types.hs +++ b/src/Data/Prune/Types.hs @@ -1,3 +1,4 @@ +-- |Types for pruning. module Data.Prune.Types where import Prelude @@ -6,6 +7,7 @@ import Data.Set (Set) import Data.Text (Text) +-- |The type of the thing to compile. data CompilableType = CompilableTypeLibrary | CompilableTypeExecutable @@ -20,33 +22,41 @@ CompilableTypeTest -> "test" CompilableTypeBenchmark -> "benchmark" +-- |The name of the thing to compile. newtype CompilableName = CompilableName { unCompilableName :: Text } deriving (Eq, Ord, Show) +-- |The name of the dependency as listed in package.yaml data DependencyName = DependencyName { unDependencyName :: Text } deriving (Eq, Ord, Show) +-- |A qualified module name, like `Foo.Bar` data ModuleName = ModuleName { unModuleName :: Text } deriving (Eq, Ord, Show) +-- |A thing to compile. data Compilable = Compilable { compilableName :: CompilableName , compilableType :: CompilableType , compilableDependencies :: Set DependencyName + -- ^ The list of dependencies less the common dependencies. , compilableFiles :: Set FilePath + -- ^ The files under `source-dirs`. } deriving (Eq, Ord, Show) data Package = Package { packageName :: Text , packageBaseDependencies :: Set DependencyName + -- ^ The list of common dependencies. , packageCompilables :: [Compilable] + -- ^ The things to compile in the package. } deriving (Eq, Ord, Show) data StackYaml = StackYaml { stackYamlPackages :: [FilePath] - -- ^ FIXME not every package is this way. + -- ^ The list of packages in stack.yaml. FIXME not every package is this way. } deriving (Eq, Ord, Show)