check-pvp-0.0.3: src/Basic.hs

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