check-pvp (empty) → 0.0
raw patch · 4 files changed
+825/−0 lines, 4 filesdep +Cabaldep +basedep +containerssetup-changed
Dependencies added: Cabal, base, containers, explicit-exception, filepath, haskell-src-exts, non-empty, transformers, utility-ht
Files
- LICENSE +31/−0
- Setup.lhs +3/−0
- check-pvp.cabal +218/−0
- src/Main.hs +573/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2014, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of contributors may not be used to endorse or promote+ products derived from this software without specific prior+ written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ check-pvp.cabal view
@@ -0,0 +1,218 @@+Name: check-pvp+Version: 0.0+License: BSD3+License-File: LICENSE+Author: Henning Thielemann <haskell@henning-thielemann.de>+Maintainer: Henning Thielemann <haskell@henning-thielemann.de>+Homepage: http://www.haskell.org/haskellwiki/Import_modules_properly+Category: Distribution+Synopsis: Check whether module and package imports conform to the PVP+Description:+ Check whether the version ranges used in the @Build-Depends@ field+ matches the style of module imports+ according to the Package Versioning Policy (PVP).+ See <http://www.haskell.org/haskellwiki/Package_versioning_policy>.+ The tool essentially looks for any dependency+ like @containers >=0.5 && <0.6@+ that allows the addition of identifiers to modules+ within the version range.+ Then it checks whether all module imports from @containers@+ are protected against name clashes+ that could be caused by addition of identifiers.+ .+ You must run the tool in a directory containing a Cabal package.+ .+ > $ check-pvp+ .+ This requires that the package is configured,+ since only then the association of packages to modules is known.+ If you want to run the tool on a non-configured package+ you may just check all imports for addition-proof style.+ .+ > $ check-pvp --include-all+ .+ It follows a detailed description of the procedure+ and the rationale behind it.+ .+ First the program classifies all dependencies+ in the Cabal file of the package.+ You can show all classifications with the @--classify-dependencies@ option,+ otherwise only problematic dependencies are shown.+ .+ A dependency like @containers >=0.5.0.3 && <0.5.1@+ does not allow changes of the API of @containers@+ and thus the program does not check its imports.+ Clashing import abbreviations are an exception.+ .+ The dependency @containers >=0.5.1 && <0.6@+ 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!+ I warmly recommend this kind of dependency range+ since it greatly reduces the work+ to keep your package going together with its imported packages.+ .+ Dependencies like @containers >=0.5@ or @containers >=0.5 && <1@+ are always problematic,+ since within the specified version ranges identifier can disappear.+ There is no import style that protects against removed identifiers.+ .+ An inclusive upper bound as in @containers >=0.5 && <=0.6@+ will also cause a warning, because it is unnecessarily strict.+ If you know that @containers-0.6@ works for you,+ then @containers-0.6.0.1@ or @containers-0.6.1@ will also work,+ depending on your import style.+ A special case of inclusive upper bounds are specific versions+ like in @containers ==0.6@.+ The argument for the warning remains the same.+ .+ 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@+ but import in a way that risks name clashes,+ then you may just extend the dependency to @containers >=0.5 && <0.6.1@+ in order to let the checker fall silent.+ If you use the dependency @containers >=0.5 && <0.6.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@.+ Other versions would then work, too,+ due to the constraints imposed by package versioning policy.+ .+ Let us now look at imports+ that must be protected against identifier additions.+ .+ The program may complain about a lax import.+ This means you have imported like+ .+ > import Data.Map as Map+ .+ Additions to @Data.Map@ may clash with other identifiers,+ thus you must import either+ .+ > import qualified Data.Map as Map+ .+ or+ .+ > import Data.Map (Map)+ .+ The program may complain about an open list of constructors as in+ .+ > import Data.Sequence (ViewL(..))+ .+ Additions of constructors to @ViewL@ may also conflict with other identifiers.+ You must instead import like+ .+ > import Data.Sequence (ViewL(EmptyL, (:<)))+ .+ or+ .+ > import qualified Data.Sequence as Seq+ .+ The program emits an error on clashing module abbreviations like+ .+ > import qualified Data.Map.Lazy as Map+ > import qualified Data.Map.Strict as Map+ .+ This error is raised+ whenever multiple modules are imported with the same abbreviation,+ where at least one module is open for additions.+ Our test is overly strict in the sense that it also blames+ .+ > import qualified Data.Map as Map+ > import qualified Data.Map as Map+ .+ but I think it is good idea to avoid redundant imports anyway.+ .+ Additionally you can enable a test for hiding imports+ with the @--pedantic@ option.+ The import+ .+ > import Data.Map hiding (insert)+ .+ is not bad in the sense of the PVP,+ but this way you depend on the existence of the identifier @insert@+ although you do not need it.+ If it is removed in a later version of @containers@,+ then your import breaks although you did not use the identifier.+ .+ 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@.+ 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@.+ You can just check all imports for being addition-proof+ using the @--include-all@ option.+ Following you can write the options+ @--include-import@,+ @--exclude-import@,+ @--include-dependency@,+ @--exclude-dependency@+ that allow to additionally check or ignore imports+ from certain modules or packages.+ These modifiers are applied from left to right.+ E.g. @--exclude-import=Prelude@ will accept any import style for @Prelude@+ and @--exclude-dependency=foobar@ will ignore the package @foobar@,+ say, because it does not conform to the PVP.+ .+ Secondly, you may ignore certain modules or components of the package+ using the options+ @--exclude-module@,+ @--exclude-library@,+ @--exclude-executables@,+ @--exclude-testsuites@,+ @--exclude-benchmarks@.+ E.g. @--exclude-module=Paths_PKG@ will exclude the Paths module+ that is generated by Cabal.+ I assume that it will always be free of name clashes.+ .+ Known problems:+ .+ * The program cannot automatically filter out the @Paths@ module.+ .+ * The program cannot find and check preprocessed modules.+ .+ * The program may yield wrong results in the presence of Cabal conditions.+ .+ If this program proves to be useful+ it might eventually be integrated in the @check@ command of @cabal-install@.+ See <https://github.com/haskell/cabal/issues/1703>.+ .+ Alternative:+ If you want to allow exclusively large version ranges, i.e. @>=x.y && <x.y+1@,+ then you may also add the option @-fwarn-missing-import-lists@+ to the @GHC-Options@ fields of your Cabal file.+ See <https://ghc.haskell.org/trac/ghc/ticket/4977>.+ Unfortunately there is no GHC warning on clashing module abbreviations.+ See <https://ghc.haskell.org/trac/ghc/ticket/4980>.+Tested-With: GHC==7.4.2+Cabal-Version: >=1.6+Build-Type: Simple+Source-Repository head+ type: darcs+ location: http://code.haskell.org/~thielema/check-pvp/++Source-Repository this+ type: darcs+ location: http://code.haskell.org/~thielema/check-pvp/+ tag: 0.0+++Executable check-pvp+ Build-Depends:+ Cabal >=1.6 && <1.19,+ haskell-src-exts >=1.14 && <1.15,+ filepath >=1.1 && <1.4,+ containers >=0.2 && <0.6,+ explicit-exception >=0.1.4 && <0.2,+ transformers >=0.2 && <0.4,+ non-empty >=0.1.3 && <0.3,+ utility-ht >=0.0.10 && <0.1,+ base >=4 && <4.7++ GHC-Options: -Wall+ Hs-Source-Dirs: src+ Main-Is: Main.hs
+ src/Main.hs view
@@ -0,0 +1,573 @@+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,+ flagPedantic :: 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,+ flagPedantic = False,+ 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 [] ["pedantic"]+ (NoArg (\flags -> return $ flags{flagPedantic = True}))+ "also check for hiding imports" :++ 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,+ checkPedantic :: 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 $ flagClassifyDependencies 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,+ checkPedantic = flagPedantic 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 modu -> checkModule flags modu++checkModule :: CheckFlags -> Syntax.Module -> IO ()+checkModule flags+ (Syntax.Module _loc _name _pragma _warn _export imports _decls) = do+ forM_ (filter (criticalModule flags . Syntax.importModule) imports) $ \imp -> do+ let problems =+ Mn.when (not $ strictImport imp) ["lax import"]+ +++ (Mn.when+ (checkPedantic flags && Fold.any fst (Syntax.importSpecs imp))+ ["hiding import"])+ +++ (flip map (implicitSpecs imp) $ \name ->+ "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 :: Bool -> DepAttrs -> IO ()+printUpperBoundDiagnostics classifyAll 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 classifyAll+ then msgs+ else filter fst msgs++ in when (not $ null filteredMsgs) $ do+ putStrLn $ unpackPkgName $ depPkgName depAttrs+ putStrLn $ unlines $ map (replicate 4 ' ' ++) filteredMsgs++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