check-pvp 0.0.2.1 → 0.0.3
raw patch · 5 files changed
+100/−81 lines, 5 filesdep ~Cabaldep ~haskell-packagesdep ~haskell-src-exts
Dependency ranges changed: Cabal, haskell-packages, haskell-src-exts, hse-cpp, tagged
Files
- check-pvp.cabal +10/−10
- src/Advanced.hs +11/−11
- src/Basic.hs +6/−5
- src/CheckPVP.hs +63/−47
- src/ModuleSet.hs +10/−8
check-pvp.cabal view
@@ -1,5 +1,5 @@ Name: check-pvp-Version: 0.0.2.1+Version: 0.0.3 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -29,7 +29,7 @@ * @precis@: <http://hackage.haskell.org/package/precis> . * @apidiff@: <http://code.haskell.org/gtk2hs/tools/apidiff/>-Tested-With: GHC==7.4.2+Tested-With: GHC==7.4.2, GHC==8.4.4 Cabal-Version: >=1.6 Build-Type: Simple Extra-Source-Files:@@ -42,7 +42,7 @@ Source-Repository this type: darcs location: http://hub.darcs.net/thielema/check-pvp/- tag: 0.0.2.1+ tag: 0.0.3 Flag advanced description: Build executable based on haskell-package@@ -51,8 +51,8 @@ Executable check-pvp Build-Depends:- Cabal >=1.6 && <1.20,- haskell-src-exts >=1.14 && <1.15,+ Cabal >=2.0 && <2.2,+ haskell-src-exts >=1.21 && <1.22, filepath >=1.1 && <1.5, containers >=0.2 && <0.7, explicit-exception >=0.1.4 && <0.2,@@ -72,11 +72,11 @@ 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,+ haskell-packages >=0.6.2 && <0.7,+ hse-cpp >=0.2 && <0.3,+ Cabal >=2.0 && <2.2,+ haskell-src-exts >=1.21 && <1.22,+ tagged >=0.4.5 && <0.9, filepath >=1.1 && <1.5, containers >=0.2 && <0.7, explicit-exception >=0.1.4 && <0.2,
src/Advanced.hs view
@@ -10,15 +10,15 @@ import qualified Distribution.PackageDescription.Configuration as Config import qualified Distribution.PackageDescription as P-import Distribution.PackageDescription.Parse (readPackageDescription, )+import Distribution.PackageDescription.Parse (readGenericPackageDescription, ) import Distribution.Simple.Utils (defaultPackageDesc)+import Distribution.Version (mkVersion') -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.CPP as CPP+import qualified Language.Haskell.Exts.Syntax as Syntax+import qualified Language.Haskell.Exts as HSE import qualified Language.Haskell.Exts as UnAnn-import Language.Haskell.Exts.Annotated.CPP (CpphsOptions, defines, )+import Language.Haskell.Exts.CPP (CpphsOptions, defines, ) import Language.Haskell.Exts.SrcLoc (SrcLoc(SrcLoc), ) import Language.Haskell.Exts.Extension (Language(Haskell98), Extension, knownExtensions, knownLanguages, )@@ -56,7 +56,7 @@ theTool = Compiler.simple "check-pvp"- version+ (mkVersion' version) knownLanguages knownExtensions compile@@ -70,9 +70,9 @@ parse :: Language -> [Extension] -> CpphsOptions -> FilePath ->- IO (HSE.Module HSE.SrcSpan)+ IO (HSE.Module HSE.SrcSpanInfo) parse lang exts cppOpts file =- return . fmap HSE.srcInfoSpan . fst+ return . fst =<< fromParseResult =<< CPP.parseFileWithCommentsAndCPP (fixCppOpts cppOpts) (mode lang exts file) file@@ -95,7 +95,7 @@ let verbosity = CheckPVP.flagVerbosity flags desc <- fmap Config.flattenPackageDescription .- readPackageDescription verbosity+ readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity let classified = CheckPVP.classifyDependencies $ P.buildDepends desc@@ -106,4 +106,4 @@ moduleSet <- mapM (parse lang exts cppOpts) files forM_ moduleSet $ \(Syntax.Module _loc _head _pragma imports _decls) ->- CheckPVP.checkImports checkFlags (map Simp.sImportDecl imports)+ CheckPVP.checkImports checkFlags imports
src/Basic.hs view
@@ -8,7 +8,8 @@ import qualified Distribution.PackageDescription.Configuration as Config import qualified Distribution.PackageDescription as P -import Distribution.PackageDescription.Parse (readPackageDescription, )+import Distribution.Types.UnqualComponentName (unUnqualComponentName, )+import Distribution.PackageDescription.Parse (readGenericPackageDescription, ) import Distribution.Simple.Utils (defaultPackageDesc, findModuleFiles, notice, ) import qualified Control.Monad.Exception.Synchronous as Exc@@ -29,7 +30,7 @@ let verbosity = CheckPVP.flagVerbosity flags desc <- fmap Config.flattenPackageDescription .- readPackageDescription verbosity+ readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity notice verbosity "Package description"@@ -53,7 +54,7 @@ when (CheckPVP.flagCheckExecutables flags) $ do notice verbosity "Executables" P.withExe desc $ \exe -> do- let name = P.exeName exe+ let name = unUnqualComponentName $ P.exeName exe notice verbosity name let bi = P.buildInfo exe modules =@@ -67,7 +68,7 @@ when (CheckPVP.flagCheckTestSuites flags) $ do notice verbosity "Test-Suites" P.withTest desc $ \exe -> do- let name = P.testName exe+ let name = unUnqualComponentName $ P.testName exe notice verbosity name let bi = P.testBuildInfo exe modules =@@ -84,7 +85,7 @@ when (CheckPVP.flagCheckBenchmarks flags) $ do notice verbosity "Benchmarks" P.withBenchmark desc $ \exe -> do- let name = P.benchmarkName exe+ let name = unUnqualComponentName $ P.benchmarkName exe notice verbosity name let bi = P.benchmarkBuildInfo exe modules =
src/CheckPVP.hs view
@@ -1,6 +1,7 @@ module CheckPVP where import qualified ModuleSet+import ModuleSet (ModuleName) import qualified Language.Haskell.Exts.Parser as Parser import qualified Language.Haskell.Exts.Syntax as Syntax@@ -14,7 +15,8 @@ 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.Package (PackageName, unPackageName, )+import Distribution.Simple.PackageIndex (InstalledPackageIndex, ) import Distribution.Simple.Utils (findFileWithExtension', ) import qualified Distribution.Verbosity as Verbosity@@ -46,6 +48,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Control.Monad (when, )+import Control.Applicative ((<$>), ) import Control.Functor.HT (void, ) import Data.Maybe (mapMaybe, ) import Data.Set (Set, )@@ -64,9 +67,10 @@ flagCheckExecutables, flagCheckTestSuites, flagCheckBenchmarks :: Bool,- flagExcludedModules :: Set Syntax.ModuleName,+ flagExcludedModules :: Set ModuleName, flagLoadPackageIndex :: Bool,- flagCriticalModules :: PkgIdx.PackageIndex -> [DepAttrs] -> ModuleSet.T,+ flagCriticalModules ::+ InstalledPackageIndex -> [DepAttrs] -> ModuleSet.T, flagCriticalModified :: Bool } @@ -126,13 +130,13 @@ Option [] ["include-import"] (ReqArg (\str flags -> return $- modifyFlagCritical (ModuleSet.insert (Syntax.ModuleName str)) flags)+ modifyFlagCritical (ModuleSet.insert (moduleName str)) flags) "MODULE") "check import of MODULE" : Option [] ["exclude-import"] (ReqArg (\str flags -> return $- modifyFlagCritical (ModuleSet.delete (Syntax.ModuleName str)) flags)+ modifyFlagCritical (ModuleSet.delete (moduleName str)) flags) "MODULE") "ignore import of MODULE" : Option [] ["include-dependency"]@@ -154,7 +158,7 @@ (ReqArg (\str flags -> return $ flags{flagExcludedModules =- Set.insert (Syntax.ModuleName str) $+ Set.insert (moduleName str) $ flagExcludedModules flags}) "MODULE") "do not check MODULE" :@@ -179,7 +183,7 @@ modifyFlagCriticalWithPkgIdx :: Bool ->- (PkgIdx.PackageIndex -> ModuleSet.T -> ModuleSet.T) ->+ (InstalledPackageIndex -> ModuleSet.T -> ModuleSet.T) -> Flags -> Flags modifyFlagCriticalWithPkgIdx loadPkgIdx modify flags = flags {@@ -190,9 +194,9 @@ flagLoadPackageIndex = loadPkgIdx || flagLoadPackageIndex flags } -moduleSetFromPackage :: PkgIdx.PackageIndex -> String -> Set Syntax.ModuleName+moduleSetFromPackage :: InstalledPackageIndex -> String -> Set ModuleName moduleSetFromPackage pkgIdx name =- lookupPkgModuleSet pkgIdx (Pkg.PackageName name)+ lookupPkgModuleSet pkgIdx $ Pkg.mkPackageName name getFlags :: Exc.ExceptionalT String IO Flags@@ -217,7 +221,7 @@ data CheckFlags = CheckFlags {- criticalModule :: Syntax.ModuleName -> Bool,+ criticalModule :: ModuleName -> Bool, showWarnings :: Bool } @@ -244,13 +248,13 @@ return Nothing Just mainPath -> return $ Just mainPath -loadPackageIndex :: FilePath -> IO PkgIdx.PackageIndex+loadPackageIndex :: FilePath -> IO InstalledPackageIndex loadPackageIndex buildDir = fmap LBI.installedPkgs $ Configure.getPersistBuildConfig buildDir dependentModules ::- PkgIdx.PackageIndex -> [DepAttrs] -> Set Syntax.ModuleName+ InstalledPackageIndex -> [DepAttrs] -> Set ModuleName dependentModules pkgIdx = foldMap (lookupPkgModuleSet pkgIdx) . map depPkgName .@@ -263,24 +267,26 @@ Tight _ -> False) lookupPkgModuleSet ::- PkgIdx.PackageIndex -> Pkg.PackageName -> Set Syntax.ModuleName+ InstalledPackageIndex -> Pkg.PackageName -> Set ModuleName lookupPkgModuleSet pkgIdx name = Set.fromList $- map syntaxFromDistModuleName $+ map (syntaxFromDistModuleName . InstPkg.exposedName) $ concatMap InstPkg.exposedModules $ concatMap snd $ PkgIdx.lookupPackageName pkgIdx name excludeModules ::- Set Syntax.ModuleName ->+ Set ModuleName -> [DistModuleName.ModuleName] -> [DistModuleName.ModuleName] excludeModules set = filter (not . flip Set.member set . syntaxFromDistModuleName) -syntaxFromDistModuleName ::- DistModuleName.ModuleName -> Syntax.ModuleName+moduleName :: String -> Syntax.ModuleName ()+moduleName = Syntax.ModuleName ()++syntaxFromDistModuleName :: DistModuleName.ModuleName -> ModuleName syntaxFromDistModuleName =- Syntax.ModuleName . List.intercalate "." . DistModuleName.components+ moduleName . List.intercalate "." . DistModuleName.components checkModules :: CheckFlags -> [(FilePath, FilePath)] -> IO () checkModules flags paths =@@ -294,19 +300,30 @@ 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+ Parser.ParseOk modu ->+ case modu of+ Syntax.Module _loc _head _pragma imports _decls ->+ checkImports flags imports+ Syntax.XmlPage _loc _name _pragma _xname _xattr _exp0 _exp1 ->+ hPrintf IO.stderr "\n%s: Don't how to process XML.\n" path+ Syntax.XmlHybrid+ _loc _head _pragma imports _decls+ _xname _xattr _exp0 _exp1 ->+ checkImports flags imports -checkImports :: CheckFlags -> [Syntax.ImportDecl] -> IO ()+checkImports :: CheckFlags -> [Syntax.ImportDecl SrcLoc.SrcSpanInfo] -> IO () checkImports flags imports = do- forM_ (filter (criticalModule flags . Syntax.importModule) imports) $ \imp -> do+ forM_+ (filter+ (criticalModule flags . fmap (const ()) . 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)+ (Fold.any hidingImport $ Syntax.importSpecs imp) ["Warning: hiding import"] ++ (flip map (implicitSpecs imp) $ \name ->@@ -316,7 +333,7 @@ when (not $ null problems) $ do void $ printf "\n%s:\n Problems encountered in import of %s:\n"- (formatSrcLoc $ Syntax.importLoc imp)+ (formatSrcLoc $ SrcLoc.getPointLoc $ Syntax.importAnn imp) (unpackModuleName $ Syntax.importModule imp) putStr $ unlines $ map (replicate 8 ' ' ++) problems @@ -335,8 +352,8 @@ (\impAs -> (impAs, Set.singleton- (Syntax.importLoc imp,- Syntax.importModule imp)))+ (Syntax.importAnn imp,+ const () <$> Syntax.importModule imp))) (Syntax.importAs imp)) $ imports @@ -346,7 +363,7 @@ (unpackModuleName impAs) forM_ (Set.toAscList conflicts) $ \(loc, modu) -> printf "\n%s:\n conflicting import of %s\n"- (formatSrcLoc loc)+ (formatSrcLoc $ SrcLoc.getPointLoc loc) (unpackModuleName modu) formatSrcLoc :: SrcLoc.SrcLoc -> String@@ -356,30 +373,32 @@ (SrcLoc.srcLine loc) (SrcLoc.srcColumn loc) -unpackModuleName :: Syntax.ModuleName -> String-unpackModuleName (Syntax.ModuleName str) = str+unpackModuleName :: Syntax.ModuleName l -> String+unpackModuleName (Syntax.ModuleName _ str) = str -strictImport :: Syntax.ImportDecl -> Bool+hidingImport :: Syntax.ImportSpecList l -> Bool+hidingImport (Syntax.ImportSpecList _ hide _specs) = hide++strictImport :: Syntax.ImportDecl l -> Bool strictImport imp = Syntax.importQualified imp ||- Fold.any- (\(hide, _specs) -> not hide)- (Syntax.importSpecs imp)+ Fold.any (not . hidingImport) (Syntax.importSpecs imp) -implicitSpecs :: Syntax.ImportDecl -> [Syntax.Name]+implicitSpecs :: Syntax.ImportDecl l -> [Syntax.Name l] implicitSpecs imp = foldMap- (\(hide, specs) -> if hide then [] else mapMaybe maybeImplicitSpec specs)+ (\(Syntax.ImportSpecList _ hide specs) ->+ if hide then [] else mapMaybe maybeImplicitSpec specs) (Syntax.importSpecs imp) -maybeImplicitSpec :: Syntax.ImportSpec -> Maybe Syntax.Name+maybeImplicitSpec :: Syntax.ImportSpec l -> Maybe (Syntax.Name l) maybeImplicitSpec spec = case spec of- Syntax.IThingAll name -> Just name- Syntax.IThingWith _ _ -> Nothing- Syntax.IAbs _ -> Nothing- Syntax.IVar _ -> Nothing+ Syntax.IThingAll _ name -> Just name+ Syntax.IThingWith _ _ _ -> Nothing+ Syntax.IAbs _ _ _ -> Nothing+ Syntax.IVar _ _ -> Nothing data DepAttrs =@@ -430,10 +449,10 @@ then when (not $ null filteredMsgs) $ putStr $ unlines $ "" :- unpackPkgName (depPkgName depAttrs) :+ unPackageName (depPkgName depAttrs) : map (replicate 4 ' ' ++) filteredMsgs else forM_ filteredMsgs $ \msg ->- printf "%s: %s\n" (unpackPkgName $ depPkgName depAttrs) msg+ printf "%s: %s\n" (unPackageName $ depPkgName depAttrs) msg classifyDependencies :: [Pkg.Dependency] -> [DepAttrs] classifyDependencies deps =@@ -455,7 +474,7 @@ Just xs -> NonEmpty.minimumKey length $ fmap (ListRev.dropWhile (0==) .- Version.versionBranch . fst) xs+ Version.versionNumbers . fst) xs boundClass = case branches of@@ -475,6 +494,3 @@ exitFailureMsg msg = do IO.hPutStrLn IO.stderr $ "Aborted: " ++ msg exitFailure--unpackPkgName :: PackageName -> String-unpackPkgName (PackageName name) = name
src/ModuleSet.hs view
@@ -6,36 +6,38 @@ import Data.Set (Set, ) +type ModuleName = Syntax.ModuleName ()+ data T =- Content (Set Syntax.ModuleName)- | Complement (Set Syntax.ModuleName)+ Content (Set ModuleName)+ | Complement (Set ModuleName) -fromSet :: Set Syntax.ModuleName -> T+fromSet :: Set ModuleName -> T fromSet = Content full :: T full = Complement Set.empty -member :: Syntax.ModuleName -> T -> Bool+member :: ModuleName -> T -> Bool member modu (Content set) = Set.member modu set member modu (Complement set) = not $ Set.member modu set -insert :: Syntax.ModuleName -> T -> T+insert :: ModuleName -> T -> T insert modu (Content set) = Content $ Set.insert modu set insert modu (Complement set) = Complement $ Set.delete modu set -delete :: Syntax.ModuleName -> T -> T+delete :: ModuleName -> T -> T delete modu (Content set) = Content $ Set.delete modu set delete modu (Complement set) = Complement $ Set.insert modu set -insertSet :: Set Syntax.ModuleName -> T -> T+insertSet :: Set ModuleName -> T -> T insertSet new (Content set) = Content $ Set.union new set insertSet new (Complement set) = Complement $ Set.difference set new -deleteSet :: Set Syntax.ModuleName -> T -> T+deleteSet :: Set ModuleName -> T -> T deleteSet new (Content set) = Content $ Set.difference set new deleteSet new (Complement set) = Complement $ Set.union new set