-- | Contains an @sdist@ like function which computes the source files -- that we should track to determine if a rebuild is necessary. -- Unlike @sdist@, we can operate directly on the true -- 'PackageDescription' (not flattened). -- -- The naming convention, roughly, is that to declare we need the -- source for some type T, you use the function needT; some functions -- need auxiliary information. -- -- We can only use this code for non-Custom scripts; Custom scripts -- may have arbitrary extra dependencies (esp. new preprocessors) which -- we cannot "see" easily. module Distribution.Client.SourceFiles (needElaboratedConfiguredPackage) where import Control.Monad.IO.Class import Distribution.Client.ProjectPlanning.Types import Distribution.Client.RebuildMonad import Distribution.Solver.Types.OptionalStanza import Distribution.Simple.Glob (matchDirFileGlobWithDie) import Distribution.Simple.PreProcess import Distribution.Types.PackageDescription import Distribution.Types.Component import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec) import Distribution.Types.Library import Distribution.Types.Executable import Distribution.Types.Benchmark import Distribution.Types.BenchmarkInterface import Distribution.Types.TestSuite import Distribution.Types.TestSuiteInterface import Distribution.Types.BuildInfo import Distribution.Types.ForeignLib import Distribution.Utils.Path import Distribution.ModuleName import Prelude () import Distribution.Client.Compat.Prelude import Distribution.Verbosity (silent) import System.FilePath needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild () needElaboratedConfiguredPackage elab = case elabPkgOrComp elab of ElabComponent ecomp -> needElaboratedComponent elab ecomp ElabPackage epkg -> needElaboratedPackage elab epkg needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild () needElaboratedPackage elab epkg = traverse_ (needComponent pkg_descr) (enabledComponents pkg_descr enabled) where pkg_descr :: PackageDescription pkg_descr = elabPkgDescription elab enabled_stanzas :: OptionalStanzaSet enabled_stanzas = pkgStanzasEnabled epkg enabled :: ComponentRequestedSpec enabled = enableStanzas enabled_stanzas needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild () needElaboratedComponent elab ecomp = case mb_comp of Nothing -> needSetup Just comp -> needComponent pkg_descr comp where pkg_descr :: PackageDescription pkg_descr = elabPkgDescription elab mb_comp :: Maybe Component mb_comp = fmap (getComponent pkg_descr) (compComponentName ecomp) needComponent :: PackageDescription -> Component -> Rebuild () needComponent pkg_descr comp = case comp of CLib lib -> needLibrary pkg_descr lib CFLib flib -> needForeignLib pkg_descr flib CExe exe -> needExecutable pkg_descr exe CTest test -> needTestSuite pkg_descr test CBench bench -> needBenchmark pkg_descr bench needSetup :: Rebuild () needSetup = findFirstFileMonitored id ["Setup.hs", "Setup.lhs"] >> return () needLibrary :: PackageDescription -> Library -> Rebuild () needLibrary pkg_descr (Library { exposedModules = modules , signatures = sigs , libBuildInfo = bi }) = needBuildInfo pkg_descr bi (modules ++ sigs) needForeignLib :: PackageDescription -> ForeignLib -> Rebuild () needForeignLib pkg_descr (ForeignLib { foreignLibModDefFile = fs , foreignLibBuildInfo = bi }) = do traverse_ needIfExists fs needBuildInfo pkg_descr bi [] needExecutable :: PackageDescription -> Executable -> Rebuild () needExecutable pkg_descr (Executable { modulePath = mainPath , buildInfo = bi }) = do needBuildInfo pkg_descr bi [] needMainFile bi mainPath needTestSuite :: PackageDescription -> TestSuite -> Rebuild () needTestSuite pkg_descr t = case testInterface t of TestSuiteExeV10 _ mainPath -> do needBuildInfo pkg_descr bi [] needMainFile bi mainPath TestSuiteLibV09 _ m -> needBuildInfo pkg_descr bi [m] TestSuiteUnsupported _ -> return () -- soft fail where bi :: BuildInfo bi = testBuildInfo t needMainFile :: BuildInfo -> FilePath -> Rebuild () needMainFile bi mainPath = do -- The matter here is subtle. It might *seem* that we -- should just search for mainPath, but as per -- b61cb051f63ed5869b8f4a6af996ff7e833e4b39 'main-is' -- will actually be the source file AFTER preprocessing, -- whereas we need to get the file *prior* to preprocessing. ppFile <- findFileWithExtensionMonitored (ppSuffixes knownSuffixHandlers) (map getSymbolicPath (hsSourceDirs bi)) (dropExtension mainPath) case ppFile of -- But check the original path in the end, because -- maybe it's a non-preprocessed file with a non-traditional -- extension. Nothing -> findFileMonitored (map getSymbolicPath (hsSourceDirs bi)) mainPath >>= maybe (return ()) need Just pp -> need pp needBenchmark :: PackageDescription -> Benchmark -> Rebuild () needBenchmark pkg_descr bm = case benchmarkInterface bm of BenchmarkExeV10 _ mainPath -> do needBuildInfo pkg_descr bi [] needMainFile bi mainPath BenchmarkUnsupported _ -> return () -- soft fail where bi :: BuildInfo bi = benchmarkBuildInfo bm needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild () needBuildInfo pkg_descr bi modules = do -- NB: These are separate because there may be both A.hs and -- A.hs-boot; need to track both. findNeededModules ["hs", "lhs", "hsig", "lhsig"] findNeededModules ["hs-boot", "lhs-boot"] expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie silent (\ _ _ -> return []) (specVersion pkg_descr) "." fpath traverse_ needIfExists $ concat [ cSources bi , cxxSources bi , jsSources bi , cmmSources bi , asmSources bi , expandedExtraSrcFiles ] for_ (installIncludes bi) $ \f -> findFileMonitored ("." : includeDirs bi) f >>= maybe (return ()) need where findNeededModules :: [String] -> Rebuild () findNeededModules exts = traverse_ (findNeededModule exts) (modules ++ otherModules bi) findNeededModule :: [String] -> ModuleName -> Rebuild () findNeededModule exts m = findFileWithExtensionMonitored (ppSuffixes knownSuffixHandlers ++ exts) (map getSymbolicPath (hsSourceDirs bi)) (toFilePath m) >>= maybe (return ()) need