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.Types.UnqualComponentName (unUnqualComponentName, ) import Distribution.PackageDescription.Parse (readGenericPackageDescription, ) 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 . readGenericPackageDescription 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 = unUnqualComponentName $ 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 = unUnqualComponentName $ 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 = unUnqualComponentName $ 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