-- | 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 (normal)

import System.FilePath

needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild ()
needElaboratedConfiguredPackage ElaboratedConfiguredPackage
elab =
    case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
        ElabComponent ElaboratedComponent
ecomp -> ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
needElaboratedComponent ElaboratedConfiguredPackage
elab ElaboratedComponent
ecomp
        ElabPackage   ElaboratedPackage
epkg  -> ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
needElaboratedPackage   ElaboratedConfiguredPackage
elab ElaboratedPackage
epkg

needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
needElaboratedPackage ElaboratedConfiguredPackage
elab ElaboratedPackage
epkg =
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (PackageDescription -> Component -> Rebuild ()
needComponent PackageDescription
pkg_descr) (PackageDescription -> ComponentRequestedSpec -> [Component]
enabledComponents PackageDescription
pkg_descr ComponentRequestedSpec
enabled)
  where
    pkg_descr :: PackageDescription
    pkg_descr :: PackageDescription
pkg_descr = ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab
    enabled_stanzas :: OptionalStanzaSet
    enabled_stanzas :: OptionalStanzaSet
enabled_stanzas = ElaboratedPackage -> OptionalStanzaSet
pkgStanzasEnabled ElaboratedPackage
epkg
    enabled :: ComponentRequestedSpec
    enabled :: ComponentRequestedSpec
enabled = OptionalStanzaSet -> ComponentRequestedSpec
enableStanzas OptionalStanzaSet
enabled_stanzas

needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
needElaboratedComponent ElaboratedConfiguredPackage
elab ElaboratedComponent
ecomp =
    case Maybe Component
mb_comp of
        Maybe Component
Nothing   -> Rebuild ()
needSetup
        Just Component
comp -> PackageDescription -> Component -> Rebuild ()
needComponent PackageDescription
pkg_descr Component
comp
  where
    pkg_descr :: PackageDescription
    pkg_descr :: PackageDescription
pkg_descr = ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
elab
    mb_comp   :: Maybe Component
    mb_comp :: Maybe Component
mb_comp   = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageDescription -> ComponentName -> Component
getComponent PackageDescription
pkg_descr) (ElaboratedComponent -> Maybe ComponentName
compComponentName ElaboratedComponent
ecomp)

needComponent :: PackageDescription -> Component -> Rebuild ()
needComponent :: PackageDescription -> Component -> Rebuild ()
needComponent PackageDescription
pkg_descr Component
comp =
    case Component
comp of
        CLib Library
lib     -> PackageDescription -> Library -> Rebuild ()
needLibrary    PackageDescription
pkg_descr Library
lib
        CFLib ForeignLib
flib   -> PackageDescription -> ForeignLib -> Rebuild ()
needForeignLib PackageDescription
pkg_descr ForeignLib
flib
        CExe Executable
exe     -> PackageDescription -> Executable -> Rebuild ()
needExecutable PackageDescription
pkg_descr Executable
exe
        CTest TestSuite
test   -> PackageDescription -> TestSuite -> Rebuild ()
needTestSuite  PackageDescription
pkg_descr TestSuite
test
        CBench Benchmark
bench -> PackageDescription -> Benchmark -> Rebuild ()
needBenchmark  PackageDescription
pkg_descr Benchmark
bench

needSetup :: Rebuild ()
needSetup :: Rebuild ()
needSetup = forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored forall a. a -> a
id [FilePath
"Setup.hs", FilePath
"Setup.lhs"] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

needLibrary :: PackageDescription -> Library -> Rebuild ()
needLibrary :: PackageDescription -> Library -> Rebuild ()
needLibrary PackageDescription
pkg_descr (Library { exposedModules :: Library -> [ModuleName]
exposedModules = [ModuleName]
modules
                               , signatures :: Library -> [ModuleName]
signatures     = [ModuleName]
sigs
                               , libBuildInfo :: Library -> BuildInfo
libBuildInfo   = BuildInfo
bi })
  = PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi ([ModuleName]
modules forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)

needForeignLib :: PackageDescription -> ForeignLib -> Rebuild ()
needForeignLib :: PackageDescription -> ForeignLib -> Rebuild ()
needForeignLib PackageDescription
pkg_descr (ForeignLib { foreignLibModDefFile :: ForeignLib -> [FilePath]
foreignLibModDefFile = [FilePath]
fs
                                     , foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bi })
  = do forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> Rebuild ()
needIfExists [FilePath]
fs
       PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi []

needExecutable :: PackageDescription -> Executable -> Rebuild ()
needExecutable :: PackageDescription -> Executable -> Rebuild ()
needExecutable PackageDescription
pkg_descr (Executable { modulePath :: Executable -> FilePath
modulePath = FilePath
mainPath
                                     , buildInfo :: Executable -> BuildInfo
buildInfo  = BuildInfo
bi })
  = do PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi []
       BuildInfo -> FilePath -> Rebuild ()
needMainFile  BuildInfo
bi FilePath
mainPath

needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
needTestSuite PackageDescription
pkg_descr TestSuite
t
  = case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
      TestSuiteExeV10 Version
_ FilePath
mainPath -> do
        PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi []
        BuildInfo -> FilePath -> Rebuild ()
needMainFile  BuildInfo
bi FilePath
mainPath
      TestSuiteLibV09 Version
_ ModuleName
m ->
        PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi [ModuleName
m]
      TestSuiteUnsupported TestType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- soft fail
 where
  bi :: BuildInfo
  bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
t

needMainFile :: BuildInfo -> FilePath -> Rebuild ()
needMainFile :: BuildInfo -> FilePath -> Rebuild ()
needMainFile BuildInfo
bi FilePath
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.
    Maybe FilePath
ppFile <- [FilePath] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored
                ([PPSuffixHandler] -> [FilePath]
ppSuffixes [PPSuffixHandler]
knownSuffixHandlers)
                (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi))
                (FilePath -> FilePath
dropExtension FilePath
mainPath)
    case Maybe FilePath
ppFile of
        -- But check the original path in the end, because
        -- maybe it's a non-preprocessed file with a non-traditional
        -- extension.
        Maybe FilePath
Nothing -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)) FilePath
mainPath
                    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) FilePath -> Rebuild ()
need
        Just FilePath
pp -> FilePath -> Rebuild ()
need FilePath
pp

needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
needBenchmark PackageDescription
pkg_descr Benchmark
bm
  = case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
     BenchmarkExeV10 Version
_ FilePath
mainPath -> do
       PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi []
       BuildInfo -> FilePath -> Rebuild ()
needMainFile  BuildInfo
bi FilePath
mainPath
     BenchmarkUnsupported BenchmarkType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- soft fail
 where
  bi :: BuildInfo
  bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm

needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
needBuildInfo PackageDescription
pkg_descr BuildInfo
bi [ModuleName]
modules = do
    -- NB: These are separate because there may be both A.hs and
    -- A.hs-boot; need to track both.
    [FilePath] -> Rebuild ()
findNeededModules [FilePath
"hs", FilePath
"lhs", FilePath
"hsig", FilePath
"lhsig"]
    [FilePath] -> Rebuild ()
findNeededModules [FilePath
"hs-boot", FilePath
"lhs-boot"]
    FilePath
root <- Rebuild FilePath
askRoot
    [FilePath]
expandedExtraSrcFiles <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkg_descr) forall a b. (a -> b) -> a -> b
$ \FilePath
fpath -> Verbosity
-> (Verbosity -> FilePath -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
normal (\ Verbosity
_ FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []) (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
root FilePath
fpath
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> Rebuild ()
needIfExists forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ BuildInfo -> [FilePath]
cSources BuildInfo
bi
        , BuildInfo -> [FilePath]
cxxSources BuildInfo
bi
        , BuildInfo -> [FilePath]
jsSources BuildInfo
bi
        , BuildInfo -> [FilePath]
cmmSources BuildInfo
bi
        , BuildInfo -> [FilePath]
asmSources BuildInfo
bi
        , [FilePath]
expandedExtraSrcFiles
        ]
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (BuildInfo -> [FilePath]
installIncludes BuildInfo
bi) forall a b. (a -> b) -> a -> b
$ \FilePath
f ->
        [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileMonitored (FilePath
"." forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
includeDirs BuildInfo
bi) FilePath
f
            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) FilePath -> Rebuild ()
need
  where
    findNeededModules :: [String] -> Rebuild ()
    findNeededModules :: [FilePath] -> Rebuild ()
findNeededModules [FilePath]
exts = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        ([FilePath] -> ModuleName -> Rebuild ()
findNeededModule [FilePath]
exts)
        ([ModuleName]
modules forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)
    findNeededModule :: [String] -> ModuleName -> Rebuild ()
    findNeededModule :: [FilePath] -> ModuleName -> Rebuild ()
findNeededModule [FilePath]
exts ModuleName
m =
        [FilePath] -> [FilePath] -> FilePath -> Rebuild (Maybe FilePath)
findFileWithExtensionMonitored
            ([PPSuffixHandler] -> [FilePath]
ppSuffixes [PPSuffixHandler]
knownSuffixHandlers forall a. [a] -> [a] -> [a]
++ [FilePath]
exts)
            (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi))
            (ModuleName -> FilePath
toFilePath ModuleName
m)
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) FilePath -> Rebuild ()
need