diff --git a/app/main.hs b/app/main.hs --- a/app/main.hs +++ b/app/main.hs @@ -1,9 +1,11 @@ import Prelude -import Control.Applicative ((<|>), many) +import Control.Applicative ((<|>), many, optional) import Control.Monad (unless, when) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (defaultOutput, runLoggingT) +import Control.Monad.Logger + ( LogLevel(LevelDebug, LevelError, LevelInfo), defaultOutput, logInfo, runLoggingT + ) import Control.Monad.State (execStateT, put) import Data.Foldable (for_, traverse_) import Data.Set (Set) @@ -27,7 +29,8 @@ , optsNoIgnoreSelf :: Bool , optsExtraIgnoreList :: [T.DependencyName] , optsPackages :: [Text] - , optsVerbose :: Bool + , optsVerbosity :: T.Verbosity + , optsBuildSystem :: Maybe T.BuildSystem } defaultIgnoreList :: Set T.DependencyName @@ -37,6 +40,13 @@ , T.DependencyName "tasty" -- ignore because some packages use tasty discovery ] +verbosityToLogLevel :: T.Verbosity -> Maybe LogLevel +verbosityToLogLevel = \case + T.Silent -> Nothing + T.Error -> Just LevelError + T.Info -> Just LevelInfo + T.Debug -> Just LevelDebug + parseArgs :: IO Opts parseArgs = Opt.execParser (Opt.info (Opt.helper <*> parser) $ Opt.progDesc "Prune a Haskell project's dependencies") where @@ -61,31 +71,39 @@ Opt.long "package" <> Opt.metavar "PACKAGE" <> Opt.help "Package name(s)" ) ) - <*> Opt.switch ( - Opt.long "verbose" - <> Opt.help "Turn on verbose logging" - ) + <*> Opt.option (Opt.maybeReader T.parseVerbosity) ( + Opt.long "verbosity" + <> Opt.metavar "VERBOSITY" + <> Opt.help ("Set the verbosity level (one of " <> show T.allVerbosities <> ")") + <> Opt.value T.Error + <> Opt.showDefault ) + <*> optional ( Opt.option (Opt.maybeReader T.parseBuildSystem) ( + Opt.long "build-system" + <> Opt.metavar "BUILD_SYSTEM" + <> Opt.help ("Build system to use instead of inference (one of " <> show T.allBuildSystems <> ")") ) ) main :: IO () main = do Opts {..} <- parseArgs let ignoreList = Set.fromList optsExtraIgnoreList <> if optsNoDefaultIgnore then mempty else defaultIgnoreList - logger ma = runLoggingT ma $ case optsVerbose of - True -> defaultOutput stdout - False -> \_ _ _ _ -> pure () + logger ma = runLoggingT ma $ case verbosityToLogLevel optsVerbosity of + Nothing -> \_ _ _ _ -> pure () + Just level -> \loc src lvl str -> when (lvl >= level) $ defaultOutput stdout loc src lvl str - (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" + (buildSystem, packageDirs) <- case optsBuildSystem of + Just T.Stack -> parseStackYaml (optsProjectRoot "stack.yaml") + Just T.CabalProject -> parseCabalProjectFile (optsProjectRoot "cabal.project") + Just T.Cabal -> findCabalFiles optsProjectRoot + Nothing -> parseStackYaml (optsProjectRoot "stack.yaml") + <|> parseCabalProjectFile (optsProjectRoot "cabal.project") + <|> findCabalFiles optsProjectRoot code <- logger $ do + $logInfo $ "Using build system " <> pack (show buildSystem) + $logInfo $ "Using ignore list " <> pack (show (Set.toList ignoreList)) packages <- parseCabalFiles packageDirs ignoreList optsPackages - dependencyByModule <- liftIO $ getDependencyByModule buildSystem packages + dependencyByModule <- getDependencyByModule optsProjectRoot 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 @@ -102,4 +120,5 @@ liftIO . putStrLn . unpack $ "Some unused base dependencies for package " <> packageName liftIO . traverse_ (putStrLn . unpack . (" " <>) . T.unDependencyName) $ Set.toList baseUnusedDependencies put $ ExitFailure 1 + exitWith code diff --git a/cabal.project b/cabal.project new file mode 100644 --- /dev/null +++ b/cabal.project @@ -0,0 +1,1 @@ +packages: ./*.cabal diff --git a/package.yaml b/package.yaml deleted file mode 100644 --- a/package.yaml +++ /dev/null @@ -1,94 +0,0 @@ -name: prune-juice - -version: '0.5' -maintainer: Dan Fithian -license: MIT -copyright: 2020 Dan Fithian -category: Development -synopsis: 'Prune unused Haskell dependencies' -description: 'Prune unused Haskell dependencies - see README at ' -github: dfithian/prune-juice - -ghc-options: - - -Wall - - -fwarn-tabs - - -fwarn-redundant-constraints - - -Wincomplete-uni-patterns - - -eventlog - -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 - -dependencies: - - aeson - - base < 5.0 - - bytestring - - Cabal - - cabal-install-parsers - - containers - - directory - - filepath - - megaparsec - - monad-logger - - mtl - - process - - text - - yaml - -extra-source-files: - - stack.yaml - - package.yaml - -library: - source-dirs: - - src - -tests: - test: - main: main.hs - source-dirs: - - test - dependencies: - - file-path-th - - hspec - - - prune-juice - -executables: - prune-juice: - main: main.hs - source-dirs: - - app - dependencies: - - optparse-applicative - - - prune-juice 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: abe3414c7a1bb62701a300318224b85d8df88e1c508cb6ed260294ea435e560d +-- hash: 93117bc7273e5f6aa8627881ccd3fa5e2d539f8e2ee55d15800a5a118b3f1346 name: prune-juice -version: 0.5 +version: 0.6 synopsis: Prune unused Haskell dependencies description: Prune unused Haskell dependencies - see README at category: Development @@ -20,7 +20,9 @@ build-type: Simple extra-source-files: stack.yaml - package.yaml + cabal.project + prune-juice.cabal + test/fixtures/ghc-pkg.txt source-repository head type: git @@ -89,6 +91,7 @@ main-is: main.hs other-modules: Data.Prune.CabalSpec + Data.Prune.DependencySpec Data.Prune.ImportParserSpec Paths_prune_juice hs-source-dirs: @@ -103,6 +106,7 @@ , cabal-install-parsers , containers , directory + , file-embed , file-path-th , filepath , hspec diff --git a/src/Data/Prune/Cabal.hs b/src/Data/Prune/Cabal.hs --- a/src/Data/Prune/Cabal.hs +++ b/src/Data/Prune/Cabal.hs @@ -4,7 +4,7 @@ import Cabal.Project (prjPackages, readProject) import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Logger (MonadLogger, logInfo) +import Control.Monad.Logger (MonadLogger, logDebug) import Data.Maybe (maybeToList) import Data.Prune.File (listFilesRecursive) import Data.Set (Set) @@ -50,7 +50,7 @@ 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 + pure $ Set.filter (\fp2 -> any ($ fp2) [isExtensionOf "hs", isExtensionOf "lhs", isExtensionOf "hs-boot"]) allFiles -- |Parse a library to compile. getLibraryCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Library -> IO T.Compilable @@ -88,15 +88,10 @@ 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 + cabalFile <- maybe (fail $ "No .cabal file found in " <> fp) pure . T.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 @@ -130,7 +125,7 @@ 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) + $logDebug $ "Parsed packages " <> pack (show toReturn) pure toReturn findCabalFiles :: FilePath -> IO (T.BuildSystem, [FilePath]) 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 @@ -3,9 +3,17 @@ import Prelude hiding (unwords, words) +import Cabal.Config (cfgStoreDir, readConfig) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Logger (MonadLogger, logError) +import Data.Functor.Identity (runIdentity) +import Data.List (intercalate) import Data.Map (Map) +import Data.Maybe (catMaybes) import Data.Set (Set) import Data.Text (Text, pack, splitOn, strip, unpack, unwords, words) +import System.Directory (doesDirectoryExist) +import System.FilePath.Posix (()) import System.Process (readProcess) import qualified Data.Map as Map import qualified Data.Set as Set @@ -13,24 +21,54 @@ import Data.Prune.ImportParser (parseDependencyName, parseExposedModules) import qualified Data.Prune.Types as T -parsePkg :: Text -> IO (T.DependencyName, Set T.ModuleName) +parsePkg :: (MonadLogger m) => Text -> m (Maybe (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) + let dependencyNameInput = unpack . unwords . dropWhile (not . (==) "name:") . words . strip $ s + moduleNamesInput = unpack . unwords . dropWhile (not . (==) "exposed-modules:") . words . strip $ s + dependencyNameMay <- case parseDependencyName dependencyNameInput of + Left err -> do + $logError $ "Failed to parse dependency name due to " <> pack (show err) <> "; original input " <> pack dependencyNameInput + pure Nothing + Right x -> pure x + moduleNames <- case parseExposedModules moduleNamesInput of + Left err -> do + $logError $ "Failed to parse module names due to " <> pack (show err) <> "; original input " <> pack moduleNamesInput + pure mempty + Right x -> pure x + pure $ (, moduleNames) <$> dependencyNameMay +getCabalRawGhcPkgs :: FilePath -> IO String +getCabalRawGhcPkgs projectRoot = do + cabalConfig <- readConfig + rawGhcVersion <- readProcess "cabal" ["v2-exec", "ghc", "--", "--numeric-version"] "" + ghcVersion <- case fmap (unpack . strip) . T.lastMay . words . pack $ rawGhcVersion of + Nothing -> fail $ "Failed to parse raw GHC version for Cabal from " <> rawGhcVersion + Just v -> pure v + let cabalPkgDbDir = (\dir -> dir ("ghc-" <> ghcVersion) "package.db") . runIdentity . cfgStoreDir $ cabalConfig + localPkgDbDir = projectRoot "dist-newstyle" "packagedb" ("ghc-" <> ghcVersion) + defaultPkgs <- readProcess "cabal" ["v2-exec", "ghc-pkg", "dump"] "" + cabalPkgs <- readProcess "cabal" ["v2-exec", "ghc-pkg", "dump", "--", "--package-db", cabalPkgDbDir] "" + localPkgs <- doesDirectoryExist localPkgDbDir >>= \case + True -> Just <$> readProcess "cabal" ["v2-exec", "ghc-pkg", "dump", "--", "--package-db", localPkgDbDir] "" + False -> pure Nothing + pure . intercalate "\n---\n" . catMaybes $ [Just defaultPkgs, Just cabalPkgs, localPkgs] + +getStackRawGhcPkgs :: IO String +getStackRawGhcPkgs = readProcess "stack" ["exec", "ghc-pkg", "dump"] "" + -- |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.BuildSystem -> [T.Package] -> IO (Map T.ModuleName (Set T.DependencyName)) -getDependencyByModule buildSystem packages = do +getDependencyByModule :: (MonadIO m, MonadLogger m) => FilePath -> T.BuildSystem -> [T.Package] -> m (Map T.ModuleName (Set T.DependencyName)) +getDependencyByModule projectRoot buildSystem packages = do let allDependencies = foldMap T.packageBaseDependencies packages <> foldMap T.compilableDependencies (foldMap T.packageCompilables packages) 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"] "" + T.Stack -> liftIO getStackRawGhcPkgs + T.CabalProject -> liftIO $ getCabalRawGhcPkgs projectRoot + T.Cabal -> liftIO $ getCabalRawGhcPkgs projectRoot allPkgs <- traverse parsePkg . splitOn "\n---\n" . pack $ rawPkgs pure . 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) + . catMaybes $ 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 @@ -4,9 +4,10 @@ import Prelude import Control.Applicative ((<|>), optional, some) +import Control.Arrow (left) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Logger (MonadLogger, logInfo) +import Control.Monad.Logger (MonadLogger, logDebug, logError) import Data.List (isPrefixOf) import Data.Map (Map) import Data.Maybe (fromMaybe) @@ -15,7 +16,7 @@ import Data.Traversable (for) import Data.Void (Void) import Text.Megaparsec (Parsec, between, oneOf, parse) -import Text.Megaparsec.Char (alphaNumChar, char, space, string, symbolChar) +import Text.Megaparsec.Char (alphaNumChar, char, space, string, symbolChar, upperChar) import qualified Data.Map as Map import qualified Data.Set as Set @@ -38,14 +39,21 @@ symbolChars :: Parser String symbolChars = some (oneOf ("!#$%&*+./<=>?@^|-~:\\" :: String)) <|> some symbolChar +symbol' :: Parser String +symbol' = operator <|> some (alphaNumChar <|> oneOf ("._'" :: String)) + symbol :: Parser String -symbol = padded $ operator <|> some (alphaNumChar <|> oneOf ("._'" :: String)) +symbol = padded symbol' +moduleName :: Parser String +moduleName = padded $ fmap mconcat $ some $ fmap mconcat $ sequence [(:[]) <$> upperChar, symbol'] + pkgName :: Parser String pkgName = some (alphaNumChar <|> char '-') oneImport :: Parser T.ModuleName oneImport = void (string "import") *> space + *> optional (between "{-#" "#-}" (space *> void (string "SOURCE") *> space) *> space) *> optional (void (string "qualified") *> space) *> optional (void (padded (quoted pkgName)) *> space) *> (T.ModuleName . pack <$> (symbol <* space)) @@ -56,24 +64,27 @@ exposedModules :: Parser (Set T.ModuleName) exposedModules = void (string "exposed-modules:") *> space - *> (Set.fromList <$> some (T.ModuleName . pack <$> symbol)) + *> (Set.fromList <$> some (T.ModuleName . pack <$> moduleName)) -- |Parse a Haskell source file's imports. -parseFileImports :: FilePath -> IO (Set T.ModuleName) +parseFileImports :: FilePath -> IO (Either String (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 + left show . fmap 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 +parseDependencyName :: String -> Either String (Maybe T.DependencyName) +parseDependencyName input = + if null input + then Right Nothing + else left show . fmap Just . parse dependencyName "" $ input -- |Parse exposed modules from the `ghc-pkg` field description. -parseExposedModules :: String -> IO (Set T.ModuleName) +parseExposedModules :: String -> Either String (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 + else left show $ parse exposedModules "" input -- |Get the dependencies used by a list of modules imported by a Haskell source file. getUsedDependencies :: Map T.ModuleName (Set T.DependencyName) -> Set T.ModuleName -> Set T.DependencyName @@ -85,8 +96,12 @@ -- dependencies each of those files use, and (3) smooshing all the dependencies together to return. 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 <- 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 + liftIO (parseFileImports fp) >>= \case + Left err -> do + $logError $ "Failed to parse imports for " <> pack fp <> " due to " <> pack (show err) + pure mempty + Right moduleNames -> do + $logDebug $ "Got module names for " <> pack fp <> ": " <> pack (show moduleNames) + let usedDependencies = getUsedDependencies dependencyByModule moduleNames + $logDebug $ "Got dependency names for " <> pack fp <> ": " <> pack (show usedDependencies) + pure usedDependencies 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 @@ -8,8 +8,45 @@ import Data.Text (Text, unpack) data BuildSystem = Stack | CabalProject | Cabal - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Bounded, Enum) +instance Show BuildSystem where + show = \case + Stack -> "stack" + CabalProject -> "cabal-project" + Cabal -> "cabal" + +parseBuildSystem :: String -> Maybe BuildSystem +parseBuildSystem = \case + "stack" -> Just Stack + "cabal-project" -> Just CabalProject + "cabal" -> Just Cabal + _ -> Nothing + +allBuildSystems :: [BuildSystem] +allBuildSystems = [minBound..maxBound] + +data Verbosity = Silent | Error | Info | Debug + deriving (Eq, Ord, Bounded, Enum) + +instance Show Verbosity where + show = \case + Silent -> "silent" + Error -> "error" + Info -> "info" + Debug -> "debug" + +parseVerbosity :: String -> Maybe Verbosity +parseVerbosity = \case + "silent" -> Just Silent + "error" -> Just Error + "info" -> Just Info + "debug" -> Just Debug + _ -> Nothing + +allVerbosities :: [Verbosity] +allVerbosities = [minBound..maxBound] + -- |The type of the thing to compile. data CompilableType = CompilableTypeLibrary @@ -76,3 +113,11 @@ parseJSON = withObject "StackYaml" $ \obj -> StackYaml <$> obj .: "packages" + +headMay :: [a] -> Maybe a +headMay = \case + [] -> Nothing + x:_ -> Just x + +lastMay :: [a] -> Maybe a +lastMay = headMay . reverse diff --git a/test/Data/Prune/DependencySpec.hs b/test/Data/Prune/DependencySpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Prune/DependencySpec.hs @@ -0,0 +1,86 @@ +module Data.Prune.DependencySpec where + +import Prelude + +import Control.Monad.Logger (runNoLoggingT) +import Data.FileEmbed (embedFile) +import Data.Text.Encoding (decodeUtf8) +import System.FilePath.TH (fileRelativeToAbsolute, fileRelativeToAbsoluteStr) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy, xit) +import qualified Data.Map as Map +import qualified Data.Set as Set + +import Data.Prune.Cabal (parseCabalFile) +import qualified Data.Prune.Types as T + +-- the module being tested +import Data.Prune.Dependency + +spec :: Spec +spec = describe "Data.Prune.Dependency" $ do + let thisFile = $(fileRelativeToAbsolute "DependencySpec.hs") + projectRoot = $(fileRelativeToAbsolute "../../../") + + it "should parse the empty string" $ do + pkgs <- runNoLoggingT $ parsePkg "" + pkgs `shouldBe` Nothing + + it "should parse a ghc-pkg module" $ do + let rawModuleNames = + [ "Data.Text" + , "Data.Text.Array" + , "Data.Text.Encoding" + , "Data.Text.Encoding.Error" + , "Data.Text.Foreign" + , "Data.Text.IO" + , "Data.Text.Internal" + , "Data.Text.Internal.Builder" + , "Data.Text.Internal.Builder.Functions" + , "Data.Text.Internal.Builder.Int.Digits" + , "Data.Text.Internal.Builder.RealFloat.Functions" + , "Data.Text.Internal.Encoding.Fusion" + , "Data.Text.Internal.Encoding.Fusion.Common" + , "Data.Text.Internal.Encoding.Utf16" + , "Data.Text.Internal.Encoding.Utf32" + , "Data.Text.Internal.Encoding.Utf8" + , "Data.Text.Internal.Functions" + , "Data.Text.Internal.Fusion" + , "Data.Text.Internal.Fusion.CaseMapping" + , "Data.Text.Internal.Fusion.Common" + , "Data.Text.Internal.Fusion.Size" + , "Data.Text.Internal.Fusion.Types" + , "Data.Text.Internal.IO" + , "Data.Text.Internal.Lazy" + , "Data.Text.Internal.Lazy.Encoding.Fusion" + , "Data.Text.Internal.Lazy.Fusion" + , "Data.Text.Internal.Lazy.Search" + , "Data.Text.Internal.Private" + , "Data.Text.Internal.Read" + , "Data.Text.Internal.Search" + , "Data.Text.Internal.Unsafe" + , "Data.Text.Internal.Unsafe.Char" + , "Data.Text.Internal.Unsafe.Shift" + , "Data.Text.Lazy" + , "Data.Text.Lazy.Builder" + , "Data.Text.Lazy.Builder.Int" + , "Data.Text.Lazy.Builder.RealFloat" + , "Data.Text.Lazy.Encoding" + , "Data.Text.Lazy.IO" + , "Data.Text.Lazy.Internal" + , "Data.Text.Lazy.Read" + , "Data.Text.Read" + , "Data.Text.Unsafe" + ] + pkgs <- runNoLoggingT $ parsePkg $ decodeUtf8 $(embedFile =<< fileRelativeToAbsoluteStr "../../fixtures/ghc-pkg.txt") + pkgs `shouldBe` Just (T.DependencyName "text", Set.fromList . fmap T.ModuleName $ rawModuleNames) + + -- this test doesn't succeed under `stack test` presumably because stack is using a different version of cabal + xit "loads dependencies for this testing module using cabal" $ do + package <- parseCabalFile projectRoot mempty + thisModule <- runNoLoggingT $ getDependencyByModule thisFile T.Cabal [package] + Set.unions (Map.elems thisModule) `shouldSatisfy` Set.member (T.DependencyName "base") + + it "loads dependencies for this testing module using stack" $ do + package <- parseCabalFile projectRoot mempty + thisModule <- runNoLoggingT $ getDependencyByModule thisFile T.Stack [package] + Set.unions (Map.elems thisModule) `shouldSatisfy` Set.member (T.DependencyName "base") 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 @@ -19,6 +19,9 @@ it "should parse imports" $ do parse oneImport "" "import Foo.Bar (foo, bar)" `shouldBe` Right (T.ModuleName "Foo.Bar") + it "should parse hs-boot files" $ do + parse oneImport "" "import {-# SOURCE #-} Foo.Bar" `shouldBe` Right (T.ModuleName "Foo.Bar") + it "should parse qualified" $ do parse oneImport "" "import qualified Foo.Bar as Baz" `shouldBe` Right (T.ModuleName "Foo.Bar") diff --git a/test/fixtures/ghc-pkg.txt b/test/fixtures/ghc-pkg.txt new file mode 100644 --- /dev/null +++ b/test/fixtures/ghc-pkg.txt @@ -0,0 +1,101 @@ +name: text +version: 1.2.4.0 +visibility: public +id: text-1.2.4.0 +key: text-1.2.4.0 +license: BSD-2-Clause +copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper +maintainer: + Bryan O'Sullivan , Herbert Valerio Riedel + +author: Bryan O'Sullivan +homepage: https://github.com/haskell/text +synopsis: An efficient packed Unicode text type. +description: + An efficient packed, immutable Unicode text type (both strict and + lazy), with a powerful loop fusion optimization framework. + + The 'Text' type represents Unicode character strings, in a time and + space-efficient manner. This package provides text processing + capabilities that are optimized for performance critical use, both + in terms of large data quantities and high speed. + + The 'Text' type provides character-encoding, type-safe case + conversion via whole-string case conversion functions (see "Data.Text"). + It also provides a range of functions for converting 'Text' values to + and from 'ByteStrings', using several standard encodings + (see "Data.Text.Encoding"). + + Efficient locale-sensitive support for text IO is also supported + (see "Data.Text.IO"). + + These modules are intended to be imported qualified, to avoid name + clashes with Prelude functions, e.g. + + > import qualified Data.Text as T + + == ICU Support + + To use an extended and very rich family of functions for working + with Unicode text (including normalization, regular expressions, + non-standard encodings, text breaking, and locales), see + the [text-icu package](https://hackage.haskell.org/package/text-icu) + based on the well-respected and liberally + licensed [ICU library](http://site.icu-project.org/). + + == Internal Representation: UTF-16 vs. UTF-8 + + Currently the @text@ library uses UTF-16 as its internal representation + which is [neither a fixed-width nor always the most dense representation](http://utf8everywhere.org/) + for Unicode text. We're currently investigating the feasibility + of [changing Text's internal representation to UTF-8](https://github.com/text-utf8) + and if you need such a 'Text' type right now you might be interested in using the spin-off + packages and + . + +category: Data, Text +abi: a27d8faf4a61dfb4d37bbb5d42c17a5b +exposed: True +exposed-modules: + Data.Text Data.Text.Array Data.Text.Encoding + Data.Text.Encoding.Error Data.Text.Foreign Data.Text.IO + Data.Text.Internal Data.Text.Internal.Builder + Data.Text.Internal.Builder.Functions + Data.Text.Internal.Builder.Int.Digits + Data.Text.Internal.Builder.RealFloat.Functions + Data.Text.Internal.Encoding.Fusion + Data.Text.Internal.Encoding.Fusion.Common + Data.Text.Internal.Encoding.Utf16 Data.Text.Internal.Encoding.Utf32 + Data.Text.Internal.Encoding.Utf8 Data.Text.Internal.Functions + Data.Text.Internal.Fusion Data.Text.Internal.Fusion.CaseMapping + Data.Text.Internal.Fusion.Common Data.Text.Internal.Fusion.Size + Data.Text.Internal.Fusion.Types Data.Text.Internal.IO + Data.Text.Internal.Lazy Data.Text.Internal.Lazy.Encoding.Fusion + Data.Text.Internal.Lazy.Fusion Data.Text.Internal.Lazy.Search + Data.Text.Internal.Private Data.Text.Internal.Read + Data.Text.Internal.Search Data.Text.Internal.Unsafe + Data.Text.Internal.Unsafe.Char Data.Text.Internal.Unsafe.Shift + Data.Text.Lazy Data.Text.Lazy.Builder Data.Text.Lazy.Builder.Int + Data.Text.Lazy.Builder.RealFloat Data.Text.Lazy.Encoding + Data.Text.Lazy.IO Data.Text.Lazy.Internal Data.Text.Lazy.Read + Data.Text.Read Data.Text.Unsafe + +hidden-modules: Data.Text.Show +import-dirs: /Users/dan/.ghcup/ghc/8.8.4/lib/ghc-8.8.4/text-1.2.4.0 +library-dirs: /Users/dan/.ghcup/ghc/8.8.4/lib/ghc-8.8.4/text-1.2.4.0 +dynamic-library-dirs: /Users/dan/.ghcup/ghc/8.8.4/lib/ghc-8.8.4/text-1.2.4.0 +data-dir: + /Users/dan/.ghcup/ghc/8.8.4/share/x86_64-osx-ghc-8.8.4/text-1.2.4.0 + +hs-libraries: HStext-1.2.4.0 +depends: + array-0.5.4.0 base-4.13.0.0 binary-0.8.7.0 bytestring-0.10.10.1 + deepseq-1.4.4.0 ghc-prim-0.5.3 integer-gmp-1.0.2.0 + template-haskell-2.15.0.0 + +haddock-interfaces: + /Users/dan/.ghcup/ghc/8.8.4/share/doc/ghc-8.8.4/html/libraries/text-1.2.4.0/text.haddock + +haddock-html: + /Users/dan/.ghcup/ghc/8.8.4/share/doc/ghc-8.8.4/html/libraries/text-1.2.4.0 +pkgroot: "/Users/dan/.ghcup/ghc/8.8.4/lib/ghc-8.8.4" diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -3,9 +3,11 @@ import Test.Hspec (hspec) import qualified Data.Prune.CabalSpec +import qualified Data.Prune.DependencySpec import qualified Data.Prune.ImportParserSpec main :: IO () main = hspec $ do Data.Prune.CabalSpec.spec + Data.Prune.DependencySpec.spec Data.Prune.ImportParserSpec.spec