diff --git a/check-pvp.cabal b/check-pvp.cabal --- a/check-pvp.cabal +++ b/check-pvp.cabal @@ -1,5 +1,5 @@ Name: check-pvp -Version: 0.0.1 +Version: 0.0.2 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -13,7 +13,7 @@ according to the Package Versioning Policy (PVP). See . The tool essentially looks for any dependency - like @containers >=0.5 && <0.6@ + like @containers >=0.5 && <0.7@ that allows the addition of identifiers to modules within the version range. Then it checks whether all module imports from @containers@ @@ -44,7 +44,7 @@ and thus the program does not check its imports. Clashing import abbreviations are an exception. . - The dependency @containers >=0.5.1 && <0.6@ + The dependency @containers >=0.5.1 && <0.7@ requires more care when importing modules from @containers@ and this is what the program is going to check next. This is the main purpose of the program! @@ -69,11 +69,11 @@ Please note that the check of ranges is performed entirely on the package description. The program will not inspect the imported module contents. - E.g. if you depend on @containers >=0.5 && <0.6@ + E.g. if you depend on @containers >=0.5 && <0.7@ but import in a way that risks name clashes, - then you may just extend the dependency to @containers >=0.5 && <0.6.1@ + then you may just extend the dependency to @containers >=0.5 && <0.7.1@ in order to let the checker fall silent. - If you use the dependency @containers >=0.5 && <0.6.1@ + If you use the dependency @containers >=0.5 && <0.7.1@ then the checker expects that you have verified that your package works with all versions of kind @0.5.x@ and the version @0.6.0@. @@ -159,7 +159,7 @@ Finally you can control what items are checked. First of all you can select the imports that are checked. Normally the imports are checked that belong to lax dependencies - like @containers >=0.5 && <0.6@. + like @containers >=0.5 && <0.7@. However this requires the package to be configured in order to know which import belongs to which dependency. E.g. @Data.Map@ belongs to @containers@. @@ -211,6 +211,9 @@ Related: There are programs that check PVP compliance of exports: . + * @cabal-bounds@: + simplifies extending the version bounds in Build-Depends fields. + . * @precis@: . * @apidiff@: @@ -219,26 +222,55 @@ Build-Type: Simple Source-Repository head type: darcs - location: http://code.haskell.org/~thielema/check-pvp/ + location: http://hub.darcs.net/thielema/check-pvp/ Source-Repository this type: darcs - location: http://code.haskell.org/~thielema/check-pvp/ - tag: 0.0.1 + location: http://hub.darcs.net/thielema/check-pvp/ + tag: 0.0.2 +Flag advanced + description: Build executable based on haskell-package + default: True + Executable check-pvp Build-Depends: - Cabal >=1.6 && <1.19, + Cabal >=1.6 && <1.20, haskell-src-exts >=1.14 && <1.15, - filepath >=1.1 && <1.4, - containers >=0.2 && <0.6, + filepath >=1.1 && <1.5, + containers >=0.2 && <0.7, explicit-exception >=0.1.4 && <0.2, - transformers >=0.2 && <0.4, - non-empty >=0.1.3 && <0.3, + transformers >=0.2 && <0.6, + non-empty >=0.1.3 && <0.4, utility-ht >=0.0.10 && <0.1, - base >=4 && <4.7 + base >=4 && <4.13 GHC-Options: -Wall Hs-Source-Dirs: src - Main-Is: Main.hs + Main-Is: Basic.hs + Other-Modules: CheckPVP + + +Executable check-pvp-compiler + If flag(advanced) + Build-Depends: + haskell-packages >=0.2.3 && <0.3, + hse-cpp >=0.1 && <0.2, + Cabal >=1.18 && <1.20, + haskell-src-exts >=1.14 && <1.15, + tagged >=0.4.5 && <0.8, + filepath >=1.1 && <1.5, + containers >=0.2 && <0.7, + explicit-exception >=0.1.4 && <0.2, + transformers >=0.2 && <0.6, + non-empty >=0.1.3 && <0.4, + utility-ht >=0.0.10 && <0.1, + base >=4 && <4.13 + Else + Buildable: False + + GHC-Options: -Wall + Hs-Source-Dirs: src + Main-Is: Advanced.hs + Other-Modules: CheckPVP diff --git a/src/Advanced.hs b/src/Advanced.hs new file mode 100644 --- /dev/null +++ b/src/Advanced.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Main where + +import qualified CheckPVP + +import Paths_check_pvp (version, ) + +import qualified Distribution.HaskellSuite.Compiler as Compiler +import Distribution.HaskellSuite.Packages (StandardDB, IsDBName, getDBName, ) + +import qualified Distribution.PackageDescription.Configuration as Config +import qualified Distribution.PackageDescription as P +import Distribution.PackageDescription.Parse (readPackageDescription, ) +import Distribution.Simple.Utils (defaultPackageDesc) + +import qualified Language.Haskell.Exts.Annotated.CPP as CPP +import qualified Language.Haskell.Exts.Annotated.Simplify as Simp +import qualified Language.Haskell.Exts.Annotated.Syntax as Syntax +import qualified Language.Haskell.Exts.Annotated as HSE +import qualified Language.Haskell.Exts as UnAnn +import Language.Haskell.Exts.Annotated.CPP (CpphsOptions, defines, ) +import Language.Haskell.Exts.SrcLoc (SrcLoc(SrcLoc), ) +import Language.Haskell.Exts.Extension + (Language(Haskell98), Extension, knownExtensions, knownLanguages, ) + +import Control.Exception (Exception, throwIO, ) +import Data.Typeable (Typeable, ) +import Data.Tagged (Tagged(Tagged), ) +import Data.Foldable (forM_, ) +import Data.Maybe (fromMaybe, ) +import Text.Printf (printf, ) + + +data PVPException = ParseError HSE.SrcLoc String + deriving Typeable + +instance Show PVPException where + show (ParseError (SrcLoc file line col) msg) = + printf "%s:%d:%d:\n %s" file line col msg + +instance Exception PVPException + +fromParseResult :: HSE.ParseResult a -> IO a +fromParseResult (HSE.ParseOk x) = return x +fromParseResult (HSE.ParseFailed loc msg) = throwIO $ ParseError loc msg + +main :: IO () +main = Compiler.main theTool + +data CheckPVPName = CheckPVPName + +instance IsDBName CheckPVPName where + getDBName = Tagged "check-pvp" + +theTool :: Compiler.Simple (StandardDB CheckPVPName) +theTool = + Compiler.simple + "check-pvp" + version + knownLanguages + knownExtensions + compile + [] + +fixCppOpts :: CpphsOptions -> CpphsOptions +fixCppOpts opts = + opts { + defines = ("__GLASGOW_HASKELL__", "763") : defines opts + } + +parse :: + Language -> [Extension] -> CpphsOptions -> FilePath -> + IO (HSE.Module HSE.SrcSpan) +parse lang exts cppOpts file = + return . fmap HSE.srcInfoSpan . fst + =<< fromParseResult + =<< CPP.parseFileWithCommentsAndCPP + (fixCppOpts cppOpts) (mode lang exts file) file + +mode :: Language -> [Extension] -> String -> UnAnn.ParseMode +mode lang exts file = + UnAnn.defaultParseMode { + UnAnn.parseFilename = file, + UnAnn.baseLanguage = lang, + UnAnn.extensions = exts, + UnAnn.ignoreLanguagePragmas = False, + UnAnn.ignoreLinePragmas = False + } + +compile :: Compiler.CompileFn +compile _buildDir mbLang exts cppOpts _pkgName _pkgdbs _deps files = do + let lang = fromMaybe Haskell98 mbLang + flags = CheckPVP.defaultFlags + + let verbosity = CheckPVP.flagVerbosity flags + desc <- + fmap Config.flattenPackageDescription . + readPackageDescription verbosity + =<< defaultPackageDesc verbosity + + let classified = CheckPVP.classifyDependencies $ P.buildDepends desc + mapM_ (CheckPVP.printUpperBoundDiagnostics flags) classified + + checkFlags <- CheckPVP.makeCheckFlags flags classified + + moduleSet <- mapM (parse lang exts cppOpts) files + forM_ moduleSet $ + \(Syntax.Module _loc _head _pragma imports _decls) -> + CheckPVP.checkImports checkFlags (map Simp.sImportDecl imports) diff --git a/src/Basic.hs b/src/Basic.hs new file mode 100644 --- /dev/null +++ b/src/Basic.hs @@ -0,0 +1,99 @@ +module Main (main) where + +import qualified CheckPVP +import CheckPVP + (findMainModule, checkModules, + excludeModules, flagExcludedModules, ) + +import qualified Distribution.PackageDescription.Configuration as Config +import qualified Distribution.PackageDescription as P + +import Distribution.PackageDescription.Parse (readPackageDescription, ) +import Distribution.Simple.Utils (defaultPackageDesc, findModuleFiles, notice, ) + +import qualified Control.Monad.Exception.Synchronous as Exc +import qualified Control.Monad.Trans.Class as MT +import Control.Monad (when, ) +import Data.Maybe (maybeToList, ) + + + +main :: IO () +main = + Exc.resolveT CheckPVP.exitFailureMsg $ + MT.lift . run =<< CheckPVP.getFlags + + +run :: CheckPVP.Flags -> IO () +run flags = do + let verbosity = CheckPVP.flagVerbosity flags + desc <- + fmap Config.flattenPackageDescription . + readPackageDescription verbosity + =<< defaultPackageDesc verbosity + + notice verbosity "Package description" + let classified = CheckPVP.classifyDependencies $ P.buildDepends desc + mapM_ (CheckPVP.printUpperBoundDiagnostics flags) classified + + checkFlags <- CheckPVP.makeCheckFlags flags classified + + when (CheckPVP.flagCheckLibrary flags) $ do + notice verbosity "Library" + P.withLib desc $ \lib -> do + let bi = P.libBuildInfo lib + modules = + excludeModules (flagExcludedModules flags) $ + P.exposedModules lib + ++ + P.otherModules bi + sourceDirs = P.hsSourceDirs bi + checkModules checkFlags =<< findModuleFiles sourceDirs ["hs"] modules + + when (CheckPVP.flagCheckExecutables flags) $ do + notice verbosity "Executables" + P.withExe desc $ \exe -> do + let name = P.exeName exe + notice verbosity name + let bi = P.buildInfo exe + modules = + excludeModules (flagExcludedModules flags) $ + P.otherModules bi + sourceDirs = P.hsSourceDirs bi + mainPath <- findMainModule sourceDirs $ P.modulePath exe + paths <- findModuleFiles sourceDirs ["hs"] modules + checkModules checkFlags $ maybeToList mainPath ++ paths + + when (CheckPVP.flagCheckTestSuites flags) $ do + notice verbosity "Test-Suites" + P.withTest desc $ \exe -> do + let name = P.testName exe + notice verbosity name + let bi = P.testBuildInfo exe + modules = + excludeModules (flagExcludedModules flags) $ + P.otherModules bi + sourceDirs = P.hsSourceDirs bi + paths <- findModuleFiles sourceDirs ["hs"] modules + mainPath <- + case P.testInterface exe of + P.TestSuiteExeV10 _ path -> findMainModule sourceDirs path + _ -> return Nothing + checkModules checkFlags $ maybeToList mainPath ++ paths + + when (CheckPVP.flagCheckBenchmarks flags) $ do + notice verbosity "Benchmarks" + P.withBenchmark desc $ \exe -> do + let name = P.benchmarkName exe + notice verbosity name + let bi = P.benchmarkBuildInfo exe + modules = + excludeModules (flagExcludedModules flags) $ + P.otherModules bi + sourceDirs = P.hsSourceDirs bi + paths <- findModuleFiles sourceDirs ["hs"] modules + mainPath <- + case P.benchmarkInterface exe of + P.BenchmarkExeV10 _ path -> findMainModule sourceDirs path + _ -> return Nothing + checkModules checkFlags $ maybeToList mainPath ++ paths diff --git a/src/CheckPVP.hs b/src/CheckPVP.hs new file mode 100644 --- /dev/null +++ b/src/CheckPVP.hs @@ -0,0 +1,479 @@ +module CheckPVP where + +import qualified ModuleSet + +import qualified Language.Haskell.Exts.Parser as Parser +import qualified Language.Haskell.Exts.Syntax as Syntax +import qualified Language.Haskell.Exts.SrcLoc as SrcLoc +import Language.Haskell.Exts.Pretty (prettyPrint, ) + +import qualified Distribution.Package as Pkg +import qualified Distribution.Simple.LocalBuildInfo as LBI +import qualified Distribution.Simple.PackageIndex as PkgIdx +import qualified Distribution.Simple.Configure as Configure +import qualified Distribution.Simple.Setup as Setup +import qualified Distribution.InstalledPackageInfo as InstPkg +import qualified Distribution.ModuleName as DistModuleName +import Distribution.Package (PackageName(PackageName), ) +import Distribution.Simple.Utils (findFileWithExtension', ) + +import qualified Distribution.Verbosity as Verbosity +import qualified Distribution.Version as Version +import qualified Distribution.ReadE as ReadE +import Distribution.Version (Version, ) +import Distribution.Text (display, ) + + +import qualified System.Environment as Env +import qualified System.IO as IO +import System.Console.GetOpt + (ArgOrder(RequireOrder), OptDescr(Option), ArgDescr(NoArg, ReqArg), + getOpt, usageInfo, ) +import System.Exit (exitSuccess, exitFailure, ) +import System.FilePath ((), ) + +import Text.Printf (printf, hPrintf, ) + +import qualified Control.Monad.Exception.Synchronous as Exc +import qualified Control.Monad.Trans.Class as MT + +import qualified Data.NonEmpty as NonEmpty +import qualified Data.Foldable as Fold +import qualified Data.Monoid.HT as Mn +import qualified Data.List.HT as ListHT +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad (when, ) +import Control.Functor.HT (void, ) +import Data.Maybe (mapMaybe, ) +import Data.Set (Set, ) +import Data.Foldable (foldMap, forM_, ) + + +data Flags = + Flags { + flagHelp :: Bool, + flagVerbosity :: Verbosity.Verbosity, + flagBuildDir :: FilePath, + flagClassifyDependencies :: Bool, + flagClassifyGrouped :: Bool, + flagWarnings :: Bool, + flagCheckLibrary, + flagCheckExecutables, + flagCheckTestSuites, + flagCheckBenchmarks :: Bool, + flagExcludedModules :: Set Syntax.ModuleName, + flagLoadPackageIndex :: Bool, + flagCriticalModules :: PkgIdx.PackageIndex -> [DepAttrs] -> ModuleSet.T, + flagCriticalModified :: Bool + } + +defaultFlags :: Flags +defaultFlags = Flags { + flagHelp = False, + flagVerbosity = Verbosity.silent, + flagBuildDir = Setup.defaultDistPref, + flagClassifyDependencies = False, + flagClassifyGrouped = False, + flagWarnings = True, + flagCheckLibrary = True, + flagCheckExecutables = True, + flagCheckTestSuites = True, + flagCheckBenchmarks = True, + flagExcludedModules = Set.empty, + flagLoadPackageIndex = True, + flagCriticalModules = + \pkgIdx depAttrs -> + ModuleSet.fromSet $ dependentModules pkgIdx depAttrs, + flagCriticalModified = False + } + +options :: [OptDescr (Flags -> Exc.Exceptional String Flags)] +options = + Option ['h'] ["help"] + (NoArg (\flags -> return $ flags{flagHelp = True})) + "show options" : + Option ['v'] ["verbose"] + (ReqArg + (\str flags -> + fmap (\n -> flags{flagVerbosity = n}) $ + Exc.fromEither $ + ReadE.runReadE Verbosity.flagToVerbosity str) + "N") + "verbosity level: 0..3" : + Option [] ["builddir"] + (ReqArg (\str flags -> return $ flags{flagBuildDir = str}) "DIR") + (printf "directory to look for package configuration (default %s)" $ + flagBuildDir defaultFlags) : + Option [] ["classify-dependencies"] + (NoArg (\flags -> return $ flags{flagClassifyDependencies = True})) + "print diagnostics of version ranges in Build-Depends fields" : + Option [] ["disable-warnings"] + (NoArg (\flags -> return $ flags{flagWarnings = False})) + "suppress warnings" : + + Option [] ["include-all"] + (NoArg + (\flags -> + if flagCriticalModified flags + then Exc.throw "include-all option must be the first amongst module set modifiers" + else return $ + (modifyFlagCritical (const ModuleSet.full) flags) + {flagLoadPackageIndex = False})) + "check all imports, ignore package database" : + Option [] ["include-import"] + (ReqArg + (\str flags -> return $ + modifyFlagCritical (ModuleSet.insert (Syntax.ModuleName str)) flags) + "MODULE") + "check import of MODULE" : + Option [] ["exclude-import"] + (ReqArg + (\str flags -> return $ + modifyFlagCritical (ModuleSet.delete (Syntax.ModuleName str)) flags) + "MODULE") + "ignore import of MODULE" : + Option [] ["include-dependency"] + (ReqArg + (\str flags -> return $ + modifyFlagCriticalWithPkgIdx True + (\pkgIdx -> ModuleSet.insertSet (moduleSetFromPackage pkgIdx str)) flags) + "PKG") + "check all imports from PKG" : + Option [] ["exclude-dependency"] + (ReqArg + (\str flags -> return $ + modifyFlagCriticalWithPkgIdx True + (\pkgIdx -> ModuleSet.deleteSet (moduleSetFromPackage pkgIdx str)) flags) + "PKG") + "ignore all imports from PKG" : + + Option [] ["exclude-module"] + (ReqArg + (\str flags -> + return $ flags{flagExcludedModules = + Set.insert (Syntax.ModuleName str) $ + flagExcludedModules flags}) + "MODULE") + "do not check MODULE" : + Option [] ["exclude-library"] + (NoArg (\flags -> return $ flags{flagCheckLibrary = False})) + "do not check library" : + Option [] ["exclude-executables"] + (NoArg (\flags -> return $ flags{flagCheckExecutables = False})) + "do not check executables" : + Option [] ["exclude-testsuites"] + (NoArg (\flags -> return $ flags{flagCheckTestSuites = False})) + "do not check testsuites" : + Option [] ["exclude-benchmarks"] + (NoArg (\flags -> return $ flags{flagCheckBenchmarks = False})) + "do not check benchmarks" : + [] + + +modifyFlagCritical :: (ModuleSet.T -> ModuleSet.T) -> Flags -> Flags +modifyFlagCritical modify = + modifyFlagCriticalWithPkgIdx False (const modify) + +modifyFlagCriticalWithPkgIdx :: + Bool -> + (PkgIdx.PackageIndex -> ModuleSet.T -> ModuleSet.T) -> + Flags -> Flags +modifyFlagCriticalWithPkgIdx loadPkgIdx modify flags = + flags { + flagCriticalModules = + \pkgIdx depAttrs -> + modify pkgIdx $ flagCriticalModules flags pkgIdx depAttrs, + flagCriticalModified = True, + flagLoadPackageIndex = loadPkgIdx || flagLoadPackageIndex flags + } + +moduleSetFromPackage :: PkgIdx.PackageIndex -> String -> Set Syntax.ModuleName +moduleSetFromPackage pkgIdx name = + lookupPkgModuleSet pkgIdx (Pkg.PackageName name) + + +getFlags :: Exc.ExceptionalT String IO Flags +getFlags = do + argv <- MT.lift Env.getArgs + let (opts, args, errors) = + getOpt RequireOrder options argv + when (not (null errors)) $ Exc.throwT $ concat $ errors + when (not (null args)) $ Exc.throwT $ + "I have no usage for the arguments " ++ show args + flags <- + Exc.ExceptionalT $ return $ + foldl (>>=) (return defaultFlags) opts + when (flagHelp flags) + (MT.lift $ + Env.getProgName >>= \programName -> + putStrLn + (usageInfo ("Usage: " ++ programName ++ + " [OPTIONS]") options) >> + exitSuccess) + return flags + +data CheckFlags = + CheckFlags { + criticalModule :: Syntax.ModuleName -> Bool, + showWarnings :: Bool + } + +makeCheckFlags :: Flags -> [DepAttrs] -> IO CheckFlags +makeCheckFlags flags classified = do + pkgIdx <- + if flagLoadPackageIndex flags + then loadPackageIndex (flagBuildDir flags) + else return $ error "no package index loaded" + let modIdx = flagCriticalModules flags pkgIdx classified + return $ + CheckFlags { + criticalModule = flip ModuleSet.member modIdx, + showWarnings = flagWarnings flags + } + + +findMainModule :: [FilePath] -> FilePath -> IO (Maybe (FilePath, FilePath)) +findMainModule sourceDirs path = do + maybeMainPath <- findFileWithExtension' [""] sourceDirs path + case maybeMainPath of + Nothing -> do + void $ hPrintf IO.stderr "main module %s not found" path + return Nothing + Just mainPath -> return $ Just mainPath + +loadPackageIndex :: FilePath -> IO PkgIdx.PackageIndex +loadPackageIndex buildDir = + fmap LBI.installedPkgs $ + Configure.getPersistBuildConfig buildDir + +dependentModules :: + PkgIdx.PackageIndex -> [DepAttrs] -> Set Syntax.ModuleName +dependentModules pkgIdx = + foldMap (lookupPkgModuleSet pkgIdx) . + map depPkgName . + filter + (\dep -> + case depUpperBoundClass dep of + Open -> True + Lax _ -> True + Generous _ _ -> True + Tight _ -> False) + +lookupPkgModuleSet :: + PkgIdx.PackageIndex -> Pkg.PackageName -> Set Syntax.ModuleName +lookupPkgModuleSet pkgIdx name = + Set.fromList $ + map syntaxFromDistModuleName $ + concatMap InstPkg.exposedModules $ + concatMap snd $ + PkgIdx.lookupPackageName pkgIdx name + +excludeModules :: + Set Syntax.ModuleName -> + [DistModuleName.ModuleName] -> [DistModuleName.ModuleName] +excludeModules set = + filter (not . flip Set.member set . syntaxFromDistModuleName) + +syntaxFromDistModuleName :: + DistModuleName.ModuleName -> Syntax.ModuleName +syntaxFromDistModuleName = + Syntax.ModuleName . List.intercalate "." . DistModuleName.components + +checkModules :: CheckFlags -> [(FilePath, FilePath)] -> IO () +checkModules flags paths = + forM_ paths $ \(dir,path) -> do + let dirPath = dir path + txt <- readFile dirPath + case + Parser.parseWithMode + (Parser.defaultParseMode {Parser.parseFilename = dirPath}) txt of + + Parser.ParseFailed loc msg -> + hPrintf IO.stderr "\n%s\n %s\n" (formatSrcLoc loc) msg + + Parser.ParseOk + (Syntax.Module _loc _name _pragma _warn _export imports _decls) -> + checkImports flags imports + +checkImports :: CheckFlags -> [Syntax.ImportDecl] -> IO () +checkImports flags imports = do + forM_ (filter (criticalModule flags . Syntax.importModule) imports) $ \imp -> do + let problems = + Mn.when (not $ strictImport imp) ["lax import"] + ++ + Mn.when (showWarnings flags) + (Mn.when + (Fold.any fst $ Syntax.importSpecs imp) + ["Warning: hiding import"] + ++ + (flip map (implicitSpecs imp) $ \name -> + "Warning: open constructor or method list for " ++ + prettyPrint name)) + + when (not $ null problems) $ do + void $ + printf "\n%s:\n Problems encountered in import of %s:\n" + (formatSrcLoc $ Syntax.importLoc imp) + (unpackModuleName $ Syntax.importModule imp) + putStr $ unlines $ map (replicate 8 ' ' ++) problems + + let conflictAbbrevs = + Map.toAscList $ + Map.filter + (\mods -> + Set.size mods >= 2 + && + (not $ Set.null $ + Set.filter (criticalModule flags . snd) mods)) $ + Map.fromListWith Set.union $ + mapMaybe + (\imp -> + fmap + (\impAs -> + (impAs, + Set.singleton + (Syntax.importLoc imp, + Syntax.importModule imp))) + (Syntax.importAs imp)) $ + imports + + forM_ conflictAbbrevs $ \(impAs, conflicts) -> do + void $ + printf "\nMultiple modules imported with abbreviation \"%s\":\n" + (unpackModuleName impAs) + forM_ (Set.toAscList conflicts) $ \(loc, modu) -> + printf "\n%s:\n conflicting import of %s\n" + (formatSrcLoc loc) + (unpackModuleName modu) + +formatSrcLoc :: SrcLoc.SrcLoc -> String +formatSrcLoc loc = + printf "%s:%d:%d" + (SrcLoc.srcFilename loc) + (SrcLoc.srcLine loc) + (SrcLoc.srcColumn loc) + +unpackModuleName :: Syntax.ModuleName -> String +unpackModuleName (Syntax.ModuleName str) = str + +strictImport :: Syntax.ImportDecl -> Bool +strictImport imp = + Syntax.importQualified imp + || + Fold.any + (\(hide, _specs) -> not hide) + (Syntax.importSpecs imp) + +implicitSpecs :: Syntax.ImportDecl -> [Syntax.Name] +implicitSpecs imp = + foldMap + (\(hide, specs) -> if hide then [] else mapMaybe maybeImplicitSpec specs) + (Syntax.importSpecs imp) + +maybeImplicitSpec :: Syntax.ImportSpec -> Maybe Syntax.Name +maybeImplicitSpec spec = + case spec of + Syntax.IThingAll name -> Just name + Syntax.IThingWith _ _ -> Nothing + Syntax.IAbs _ -> Nothing + Syntax.IVar _ -> Nothing + + +data DepAttrs = + DepAttrs { + depPkgName :: PackageName, + depMissingUpperBounds :: [Version.LowerBound], + depInclusiveUpperBounds :: [Version], + depUpperBoundClass :: BoundClass + } + +data BoundClass = Open | Lax Int | Generous Int Int | Tight [Int] + + +printUpperBoundDiagnostics :: Flags -> DepAttrs -> IO () +printUpperBoundDiagnostics flags depAttrs = + let warn = (,) True + info = (,) False + + msgs = + (flip map (depMissingUpperBounds depAttrs) $ \(Version.LowerBound ver typ) -> + warn $ + printf "missing upper bound associated with lower bound \"%s\"" $ + display $ + case typ of + Version.InclusiveBound -> Version.orLaterVersion ver + Version.ExclusiveBound -> Version.laterVersion ver) + ++ + (flip map (depInclusiveUpperBounds depAttrs) $ \uppBnd -> + warn $ printf "found inclusive upper bound %s" $ display uppBnd) + ++ + case depUpperBoundClass depAttrs of + Open -> [] + Lax x -> [warn $ printf "upper bound %d is too lax" x] + Generous x y -> + [info $ printf "upper bound %d.%d requires strict imports" x y] + Tight xs -> + [info $ + printf "upper bound %s is tight" $ + List.intercalate "." $ map show xs] + + filteredMsgs = + map snd $ + if flagClassifyDependencies flags + then msgs + else filter fst msgs + + in if flagClassifyGrouped flags + then when (not $ null filteredMsgs) $ + putStr $ unlines $ + "" : + unpackPkgName (depPkgName depAttrs) : + map (replicate 4 ' ' ++) filteredMsgs + else forM_ filteredMsgs $ \msg -> + printf "%s: %s\n" (unpackPkgName $ depPkgName depAttrs) msg + +classifyDependencies :: [Pkg.Dependency] -> [DepAttrs] +classifyDependencies deps = + flip map deps $ \(Pkg.Dependency dependName rng) -> + let intervals = Version.asVersionIntervals rng + + maybeUpperBound Version.NoUpperBound = Nothing + maybeUpperBound (Version.UpperBound ver bnd) = Just (ver, bnd) + isExclusiveBound Version.ExclusiveBound = True + isExclusiveBound Version.InclusiveBound = False + (upperBounds, noUpperBounds) = + ListHT.partitionMaybe (maybeUpperBound . snd) intervals + (exclusiveUpperBounds, inclusiveUpperBounds) = + ListHT.partition (isExclusiveBound . snd) upperBounds + + branches = + case NonEmpty.fetch exclusiveUpperBounds of + Nothing -> [] + Just xs -> + NonEmpty.minimumKey length $ + fmap (ListHT.dropWhileRev (0==) . + Version.versionBranch . fst) xs + + boundClass = + case branches of + [] -> Open + [x] -> Lax x + [x,y] -> Generous x y + _ -> Tight branches + + in DepAttrs { + depPkgName = dependName, + depMissingUpperBounds = map fst noUpperBounds, + depInclusiveUpperBounds = map fst inclusiveUpperBounds, + depUpperBoundClass = boundClass + } + +exitFailureMsg :: String -> IO () +exitFailureMsg msg = do + IO.hPutStrLn IO.stderr $ "Aborted: " ++ msg + exitFailure + +unpackPkgName :: PackageName -> String +unpackPkgName (PackageName name) = name diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,581 +0,0 @@ -module Main (main) where - -import qualified Language.Haskell.Exts.Parser as Parser -import qualified Language.Haskell.Exts.Syntax as Syntax -import qualified Language.Haskell.Exts.SrcLoc as SrcLoc -import Language.Haskell.Exts.Pretty (prettyPrint, ) - -import qualified Distribution.PackageDescription.Configuration as Config -import qualified Distribution.PackageDescription as P -import qualified Distribution.Package as Pkg -import qualified Distribution.Simple.LocalBuildInfo as LBI -import qualified Distribution.Simple.PackageIndex as PkgIdx -import qualified Distribution.Simple.Configure as Configure -import qualified Distribution.Simple.Setup as Setup -import qualified Distribution.InstalledPackageInfo as InstPkg -import qualified Distribution.ModuleName as DistModuleName -import Distribution.PackageDescription.Parse (readPackageDescription, ) -import Distribution.Package (PackageName(PackageName), ) -import Distribution.Simple.Utils - (defaultPackageDesc, findModuleFiles, findFileWithExtension', - notice, ) - -import qualified Distribution.Verbosity as Verbosity -import qualified Distribution.Version as Version -import qualified Distribution.ReadE as ReadE -import Distribution.Version (Version, ) -import Distribution.Text (display, ) - - -import qualified System.Environment as Env -import qualified System.IO as IO -import System.Console.GetOpt - (ArgOrder(RequireOrder), OptDescr(Option), ArgDescr(NoArg, ReqArg), - getOpt, usageInfo, ) -import System.Exit (exitSuccess, exitFailure, ) -import System.FilePath ((), ) - -import Text.Printf (printf, hPrintf, ) - -import qualified Control.Monad.Exception.Synchronous as Exc -import qualified Control.Monad.Trans.Class as MT - -import qualified Data.NonEmpty as NonEmpty -import qualified Data.Foldable as Fold -import qualified Data.Monoid.HT as Mn -import qualified Data.List.HT as ListHT -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Set as Set -import Control.Monad (when, ) -import Control.Functor.HT (void, ) -import Data.Maybe (mapMaybe, maybeToList, ) -import Data.Set (Set, ) -import Data.Foldable (foldMap, forM_, ) - - -data Flags = - Flags { - flagHelp :: Bool, - flagVerbosity :: Verbosity.Verbosity, - flagBuildDir :: FilePath, - flagClassifyDependencies :: Bool, - flagClassifyGrouped :: Bool, - flagWarnings :: Bool, - flagCheckLibrary, - flagCheckExecutables, - flagCheckTestSuites, - flagCheckBenchmarks :: Bool, - flagExcludedModules :: Set Syntax.ModuleName, - flagLoadPackageIndex :: Bool, - flagCriticalModules :: PkgIdx.PackageIndex -> [DepAttrs] -> ModuleSet, - flagCriticalModified :: Bool - } - -defaultFlags :: Flags -defaultFlags = Flags { - flagHelp = False, - flagVerbosity = Verbosity.silent, - flagBuildDir = Setup.defaultDistPref, - flagClassifyDependencies = False, - flagClassifyGrouped = False, - flagWarnings = True, - flagCheckLibrary = True, - flagCheckExecutables = True, - flagCheckTestSuites = True, - flagCheckBenchmarks = True, - flagExcludedModules = Set.empty, - flagLoadPackageIndex = True, - flagCriticalModules = - \pkgIdx depAttrs -> - ModuleSet $ dependentModules pkgIdx depAttrs, - flagCriticalModified = False - } - -options :: [OptDescr (Flags -> Exc.Exceptional String Flags)] -options = - Option ['h'] ["help"] - (NoArg (\flags -> return $ flags{flagHelp = True})) - "show options" : - Option ['v'] ["verbose"] - (ReqArg - (\str flags -> - fmap (\n -> flags{flagVerbosity = n}) $ - Exc.fromEither $ - ReadE.runReadE Verbosity.flagToVerbosity str) - "N") - "verbosity level: 0..3" : - Option [] ["builddir"] - (ReqArg (\str flags -> return $ flags{flagBuildDir = str}) "DIR") - (printf "directory to look for package configuration (default %s)" $ - flagBuildDir defaultFlags) : - Option [] ["classify-dependencies"] - (NoArg (\flags -> return $ flags{flagClassifyDependencies = True})) - "print diagnostics of version ranges in Build-Depends fields" : - Option [] ["disable-warnings"] - (NoArg (\flags -> return $ flags{flagWarnings = False})) - "suppress warnings" : - - Option [] ["include-all"] - (NoArg - (\flags -> - if flagCriticalModified flags - then Exc.throw "include-all option must be the first amongst module set modifiers" - else return $ - (modifyFlagCritical - (const $ ComplementSet Set.empty) flags) - {flagLoadPackageIndex = False})) - "check all imports, ignore package database" : - Option [] ["include-import"] - (ReqArg - (\str flags -> return $ - modifyFlagCritical (insertModule (Syntax.ModuleName str)) flags) - "MODULE") - "check import of MODULE" : - Option [] ["exclude-import"] - (ReqArg - (\str flags -> return $ - modifyFlagCritical (deleteModule (Syntax.ModuleName str)) flags) - "MODULE") - "ignore import of MODULE" : - Option [] ["include-dependency"] - (ReqArg - (\str flags -> return $ - modifyFlagCriticalWithPkgIdx True - (\pkgIdx -> insertModuleSet (moduleSetFromPackage pkgIdx str)) flags) - "PKG") - "check all imports from PKG" : - Option [] ["exclude-dependency"] - (ReqArg - (\str flags -> return $ - modifyFlagCriticalWithPkgIdx True - (\pkgIdx -> deleteModuleSet (moduleSetFromPackage pkgIdx str)) flags) - "PKG") - "ignore all imports from PKG" : - - Option [] ["exclude-module"] - (ReqArg - (\str flags -> - return $ flags{flagExcludedModules = - Set.insert (Syntax.ModuleName str) $ - flagExcludedModules flags}) - "MODULE") - "do not check MODULE" : - Option [] ["exclude-library"] - (NoArg (\flags -> return $ flags{flagCheckLibrary = False})) - "do not check library" : - Option [] ["exclude-executables"] - (NoArg (\flags -> return $ flags{flagCheckExecutables = False})) - "do not check executables" : - Option [] ["exclude-testsuites"] - (NoArg (\flags -> return $ flags{flagCheckTestSuites = False})) - "do not check testsuites" : - Option [] ["exclude-benchmarks"] - (NoArg (\flags -> return $ flags{flagCheckBenchmarks = False})) - "do not check benchmarks" : - [] - - -modifyFlagCritical :: (ModuleSet -> ModuleSet) -> Flags -> Flags -modifyFlagCritical modify = - modifyFlagCriticalWithPkgIdx False (const modify) - -modifyFlagCriticalWithPkgIdx :: - Bool -> - (PkgIdx.PackageIndex -> ModuleSet -> ModuleSet) -> - Flags -> Flags -modifyFlagCriticalWithPkgIdx loadPkgIdx modify flags = - flags { - flagCriticalModules = - \pkgIdx depAttrs -> - modify pkgIdx $ flagCriticalModules flags pkgIdx depAttrs, - flagCriticalModified = True, - flagLoadPackageIndex = loadPkgIdx || flagLoadPackageIndex flags - } - -moduleSetFromPackage :: PkgIdx.PackageIndex -> String -> Set Syntax.ModuleName -moduleSetFromPackage pkgIdx name = - lookupPkgModuleSet pkgIdx (Pkg.PackageName name) - - -data ModuleSet = - ModuleSet (Set Syntax.ModuleName) - | ComplementSet (Set Syntax.ModuleName) - -memberModule :: Syntax.ModuleName -> ModuleSet -> Bool -memberModule modu (ModuleSet set) = Set.member modu set -memberModule modu (ComplementSet set) = not $ Set.member modu set - - -insertModule :: Syntax.ModuleName -> ModuleSet -> ModuleSet -insertModule modu (ModuleSet set) = ModuleSet $ Set.insert modu set -insertModule modu (ComplementSet set) = ComplementSet $ Set.delete modu set - -deleteModule :: Syntax.ModuleName -> ModuleSet -> ModuleSet -deleteModule modu (ModuleSet set) = ModuleSet $ Set.delete modu set -deleteModule modu (ComplementSet set) = ComplementSet $ Set.insert modu set - - -insertModuleSet :: Set Syntax.ModuleName -> ModuleSet -> ModuleSet -insertModuleSet new (ModuleSet set) = ModuleSet $ Set.union new set -insertModuleSet new (ComplementSet set) = ComplementSet $ Set.difference set new - -deleteModuleSet :: Set Syntax.ModuleName -> ModuleSet -> ModuleSet -deleteModuleSet new (ModuleSet set) = ModuleSet $ Set.difference set new -deleteModuleSet new (ComplementSet set) = ComplementSet $ Set.union new set - - -main :: IO () -main = - Exc.resolveT exitFailureMsg $ do - argv <- MT.lift Env.getArgs - let (opts, args, errors) = - getOpt RequireOrder options argv - when (not (null errors)) $ Exc.throwT $ concat $ errors - when (not (null args)) $ Exc.throwT $ - "I have no usage for the arguments " ++ show args - flags <- - Exc.ExceptionalT $ return $ - foldl (>>=) (return defaultFlags) opts - when (flagHelp flags) - (MT.lift $ - Env.getProgName >>= \programName -> - putStrLn - (usageInfo ("Usage: " ++ programName ++ - " [OPTIONS]") options) >> - exitSuccess) - - MT.lift $ run flags - -data CheckFlags = - CheckFlags { - criticalModule :: Syntax.ModuleName -> Bool, - showWarnings :: Bool - } - -run :: Flags -> IO () -run flags = do - let verbosity = flagVerbosity flags - pdfile <- defaultPackageDesc verbosity - desc <- - fmap Config.flattenPackageDescription $ - readPackageDescription verbosity pdfile - - notice verbosity "Package description" - let classified = classifyDependencies $ P.buildDepends desc - mapM_ (printUpperBoundDiagnostics flags) classified - - pkgIdx <- - if flagLoadPackageIndex flags - then loadPackageIndex (flagBuildDir flags) - else return $ error "no package index loaded" - let modIdx = flagCriticalModules flags pkgIdx classified - let checkFlags = - CheckFlags { - criticalModule = flip memberModule modIdx, - showWarnings = flagWarnings flags - } - - when (flagCheckLibrary flags) $ do - notice verbosity "Library" - P.withLib desc $ \lib -> do - let bi = P.libBuildInfo lib - modules = - excludeModules (flagExcludedModules flags) $ - P.exposedModules lib - ++ - P.otherModules bi - sourceDirs = P.hsSourceDirs bi - checkModules checkFlags =<< findModuleFiles sourceDirs ["hs"] modules - - when (flagCheckExecutables flags) $ do - notice verbosity "Executables" - P.withExe desc $ \exe -> do - let name = P.exeName exe - notice verbosity name - let bi = P.buildInfo exe - modules = - excludeModules (flagExcludedModules flags) $ - P.otherModules bi - sourceDirs = P.hsSourceDirs bi - mainPath <- findMainModule sourceDirs $ P.modulePath exe - paths <- findModuleFiles sourceDirs ["hs"] modules - checkModules checkFlags $ maybeToList mainPath ++ paths - - when (flagCheckTestSuites flags) $ do - notice verbosity "Test-Suites" - P.withTest desc $ \exe -> do - let name = P.testName exe - notice verbosity name - let bi = P.testBuildInfo exe - modules = - excludeModules (flagExcludedModules flags) $ - P.otherModules bi - sourceDirs = P.hsSourceDirs bi - paths <- findModuleFiles sourceDirs ["hs"] modules - mainPath <- - case P.testInterface exe of - P.TestSuiteExeV10 _ path -> findMainModule sourceDirs path - _ -> return Nothing - checkModules checkFlags $ maybeToList mainPath ++ paths - - when (flagCheckBenchmarks flags) $ do - notice verbosity "Benchmarks" - P.withBenchmark desc $ \exe -> do - let name = P.benchmarkName exe - notice verbosity name - let bi = P.benchmarkBuildInfo exe - modules = - excludeModules (flagExcludedModules flags) $ - P.otherModules bi - sourceDirs = P.hsSourceDirs bi - paths <- findModuleFiles sourceDirs ["hs"] modules - mainPath <- - case P.benchmarkInterface exe of - P.BenchmarkExeV10 _ path -> findMainModule sourceDirs path - _ -> return Nothing - checkModules checkFlags $ maybeToList mainPath ++ paths - -findMainModule :: [FilePath] -> FilePath -> IO (Maybe (FilePath, FilePath)) -findMainModule sourceDirs path = do - maybeMainPath <- findFileWithExtension' [""] sourceDirs path - case maybeMainPath of - Nothing -> do - void $ hPrintf IO.stderr "main module %s not found" path - return Nothing - Just mainPath -> return $ Just mainPath - -loadPackageIndex :: FilePath -> IO PkgIdx.PackageIndex -loadPackageIndex buildDir = - fmap LBI.installedPkgs $ - Configure.getPersistBuildConfig buildDir - -dependentModules :: - PkgIdx.PackageIndex -> [DepAttrs] -> Set Syntax.ModuleName -dependentModules pkgIdx = - foldMap (lookupPkgModuleSet pkgIdx) . - map depPkgName . - filter - (\dep -> - case depUpperBoundClass dep of - Open -> True - Lax _ -> True - Generous _ _ -> True - Tight _ -> False) - -lookupPkgModuleSet :: - PkgIdx.PackageIndex -> Pkg.PackageName -> Set Syntax.ModuleName -lookupPkgModuleSet pkgIdx name = - Set.fromList $ - map syntaxFromDistModuleName $ - concatMap InstPkg.exposedModules $ - concatMap snd $ - PkgIdx.lookupPackageName pkgIdx name - -excludeModules :: - Set Syntax.ModuleName -> - [DistModuleName.ModuleName] -> [DistModuleName.ModuleName] -excludeModules set = - filter (not . flip Set.member set . syntaxFromDistModuleName) - -syntaxFromDistModuleName :: - DistModuleName.ModuleName -> Syntax.ModuleName -syntaxFromDistModuleName = - Syntax.ModuleName . List.intercalate "." . DistModuleName.components - -checkModules :: CheckFlags -> [(FilePath, FilePath)] -> IO () -checkModules flags paths = - forM_ paths $ \(dir,path) -> do - let dirPath = dir path - txt <- readFile dirPath - case - Parser.parseWithMode - (Parser.defaultParseMode {Parser.parseFilename = dirPath}) txt of - - Parser.ParseFailed loc msg -> - hPrintf IO.stderr "\n%s\n %s\n" (formatSrcLoc loc) msg - - Parser.ParseOk - (Syntax.Module _loc _name _pragma _warn _export imports _decls) -> - checkImports flags imports - -checkImports :: CheckFlags -> [Syntax.ImportDecl] -> IO () -checkImports flags imports = do - forM_ (filter (criticalModule flags . Syntax.importModule) imports) $ \imp -> do - let problems = - Mn.when (not $ strictImport imp) ["lax import"] - ++ - Mn.when (showWarnings flags) - (Mn.when - (Fold.any fst $ Syntax.importSpecs imp) - ["Warning: hiding import"] - ++ - (flip map (implicitSpecs imp) $ \name -> - "Warning: open constructor or method list for " ++ - prettyPrint name)) - - when (not $ null problems) $ do - void $ - printf "\n%s:\n Problems encountered in import of %s:\n" - (formatSrcLoc $ Syntax.importLoc imp) - (unpackModuleName $ Syntax.importModule imp) - putStr $ unlines $ map (replicate 8 ' ' ++) problems - - let conflictAbbrevs = - Map.toAscList $ - Map.filter - (\mods -> - Set.size mods >= 2 - && - (not $ Set.null $ - Set.filter (criticalModule flags . snd) mods)) $ - Map.fromListWith Set.union $ - mapMaybe - (\imp -> - fmap - (\impAs -> - (impAs, - Set.singleton - (Syntax.importLoc imp, - Syntax.importModule imp))) - (Syntax.importAs imp)) $ - imports - - forM_ conflictAbbrevs $ \(impAs, conflicts) -> do - void $ - printf "\nMultiple modules imported with abbreviation \"%s\":\n" - (unpackModuleName impAs) - forM_ (Set.toAscList conflicts) $ \(loc, modu) -> - printf "\n%s:\n conflicting import of %s\n" - (formatSrcLoc loc) - (unpackModuleName modu) - -formatSrcLoc :: SrcLoc.SrcLoc -> String -formatSrcLoc loc = - printf "%s:%d:%d" - (SrcLoc.srcFilename loc) - (SrcLoc.srcLine loc) - (SrcLoc.srcColumn loc) - -unpackModuleName :: Syntax.ModuleName -> String -unpackModuleName (Syntax.ModuleName str) = str - -strictImport :: Syntax.ImportDecl -> Bool -strictImport imp = - Syntax.importQualified imp - || - Fold.any - (\(hide, _specs) -> not hide) - (Syntax.importSpecs imp) - -implicitSpecs :: Syntax.ImportDecl -> [Syntax.Name] -implicitSpecs imp = - foldMap - (\(hide, specs) -> if hide then [] else mapMaybe maybeImplicitSpec specs) - (Syntax.importSpecs imp) - -maybeImplicitSpec :: Syntax.ImportSpec -> Maybe Syntax.Name -maybeImplicitSpec spec = - case spec of - Syntax.IThingAll name -> Just name - Syntax.IThingWith _ _ -> Nothing - Syntax.IAbs _ -> Nothing - Syntax.IVar _ -> Nothing - - -data DepAttrs = - DepAttrs { - depPkgName :: PackageName, - depMissingUpperBounds :: [Version.LowerBound], - depInclusiveUpperBounds :: [Version], - depUpperBoundClass :: BoundClass - } - -data BoundClass = Open | Lax Int | Generous Int Int | Tight [Int] - - -printUpperBoundDiagnostics :: Flags -> DepAttrs -> IO () -printUpperBoundDiagnostics flags depAttrs = - let warn = (,) True - info = (,) False - - msgs = - (flip map (depMissingUpperBounds depAttrs) $ \(Version.LowerBound ver typ) -> - warn $ - printf "missing upper bound associated with lower bound \"%s\"" $ - display $ - case typ of - Version.InclusiveBound -> Version.orLaterVersion ver - Version.ExclusiveBound -> Version.laterVersion ver) - ++ - (flip map (depInclusiveUpperBounds depAttrs) $ \uppBnd -> - warn $ printf "found inclusive upper bound %s" $ display uppBnd) - ++ - case depUpperBoundClass depAttrs of - Open -> [] - Lax x -> [warn $ printf "upper bound %d is too lax" x] - Generous x y -> - [info $ printf "upper bound %d.%d requires strict imports" x y] - Tight xs -> - [info $ - printf "upper bound %s is tight" $ - List.intercalate "." $ map show xs] - - filteredMsgs = - map snd $ - if flagClassifyDependencies flags - then msgs - else filter fst msgs - - in if flagClassifyGrouped flags - then when (not $ null filteredMsgs) $ - putStr $ unlines $ - "" : - unpackPkgName (depPkgName depAttrs) : - map (replicate 4 ' ' ++) filteredMsgs - else forM_ filteredMsgs $ \msg -> - printf "%s: %s\n" (unpackPkgName $ depPkgName depAttrs) msg - -classifyDependencies :: [Pkg.Dependency] -> [DepAttrs] -classifyDependencies deps = - flip map deps $ \(Pkg.Dependency dependName rng) -> - let intervals = Version.asVersionIntervals rng - - maybeUpperBound Version.NoUpperBound = Nothing - maybeUpperBound (Version.UpperBound ver bnd) = Just (ver, bnd) - isExclusiveBound Version.ExclusiveBound = True - isExclusiveBound Version.InclusiveBound = False - (upperBounds, noUpperBounds) = - ListHT.partitionMaybe (maybeUpperBound . snd) intervals - (exclusiveUpperBounds, inclusiveUpperBounds) = - ListHT.partition (isExclusiveBound . snd) upperBounds - - branches = - case NonEmpty.fetch exclusiveUpperBounds of - Nothing -> [] - Just xs -> - NonEmpty.minimumKey length $ - fmap (ListHT.dropWhileRev (0==) . - Version.versionBranch . fst) xs - - boundClass = - case branches of - [] -> Open - [x] -> Lax x - [x,y] -> Generous x y - _ -> Tight branches - - in DepAttrs { - depPkgName = dependName, - depMissingUpperBounds = map fst noUpperBounds, - depInclusiveUpperBounds = map fst inclusiveUpperBounds, - depUpperBoundClass = boundClass - } - -exitFailureMsg :: String -> IO () -exitFailureMsg msg = do - IO.hPutStrLn IO.stderr $ "Aborted: " ++ msg - exitFailure - -unpackPkgName :: PackageName -> String -unpackPkgName (PackageName name) = name