cabal-install/src/Distribution/Client/SourceFiles.hs

   1 -- | Contains an @sdist@ like function which computes the source files
   2 -- that we should track to determine if a rebuild is necessary.
   3 -- Unlike @sdist@, we can operate directly on the true
   4 -- 'PackageDescription' (not flattened).
   5 --
   6 -- The naming convention, roughly, is that to declare we need the
   7 -- source for some type T, you use the function needT; some functions
   8 -- need auxiliary information.
   9 --
  10 -- We can only use this code for non-Custom scripts; Custom scripts
  11 -- may have arbitrary extra dependencies (esp. new preprocessors) which
  12 -- we cannot "see" easily.
  13 module Distribution.Client.SourceFiles (needElaboratedConfiguredPackage) where
  14
  15 import Control.Monad.IO.Class
  16
  17 import Distribution.Client.ProjectPlanning.Types
  18 import Distribution.Client.RebuildMonad
  19
  20 import Distribution.Solver.Types.OptionalStanza
  21
  22 import Distribution.Simple.Glob (matchDirFileGlobWithDie)
  23 import Distribution.Simple.PreProcess
  24
  25 import Distribution.Types.PackageDescription
  26 import Distribution.Types.Component
  27 import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec)
  28 import Distribution.Types.Library
  29 import Distribution.Types.Executable
  30 import Distribution.Types.Benchmark
  31 import Distribution.Types.BenchmarkInterface
  32 import Distribution.Types.TestSuite
  33 import Distribution.Types.TestSuiteInterface
  34 import Distribution.Types.BuildInfo
  35 import Distribution.Types.ForeignLib
  36 import Distribution.Utils.Path
  37
  38 import Distribution.ModuleName
  39
  40 import Prelude ()
  41 import Distribution.Client.Compat.Prelude
  42 import Distribution.Verbosity (silent)
  43
  44 import System.FilePath
  45
  46 needElaboratedConfiguredPackage :: ElaboratedConfiguredPackage -> Rebuild ()
  47 needElaboratedConfiguredPackage elab =
  48     case elabPkgOrComp elab of
  49         ElabComponent ecomp -> needElaboratedComponent elab ecomp
  50         ElabPackage   epkg  -> needElaboratedPackage   elab epkg
  51
  52 needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Rebuild ()
  53 needElaboratedPackage elab epkg =
  54     traverse_ (needComponent pkg_descr) (enabledComponents pkg_descr enabled)
  55   where
  56     pkg_descr :: PackageDescription
  57     pkg_descr = elabPkgDescription elab
  58     enabled_stanzas :: OptionalStanzaSet
  59     enabled_stanzas = pkgStanzasEnabled epkg
  60     enabled :: ComponentRequestedSpec
  61     enabled = enableStanzas enabled_stanzas
  62
  63 needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
  64 needElaboratedComponent elab ecomp =
  65     case mb_comp of
  66         Nothing   -> needSetup
  67         Just comp -> needComponent pkg_descr comp
  68   where
  69     pkg_descr :: PackageDescription
  70     pkg_descr = elabPkgDescription elab
  71     mb_comp   :: Maybe Component
  72     mb_comp   = fmap (getComponent pkg_descr) (compComponentName ecomp)
  73
  74 needComponent :: PackageDescription -> Component -> Rebuild ()
  75 needComponent pkg_descr comp =
  76     case comp of
  77         CLib lib     -> needLibrary    pkg_descr lib
  78         CFLib flib   -> needForeignLib pkg_descr flib
  79         CExe exe     -> needExecutable pkg_descr exe
  80         CTest test   -> needTestSuite  pkg_descr test
  81         CBench bench -> needBenchmark  pkg_descr bench
  82
  83 needSetup :: Rebuild ()
  84 needSetup = findFirstFileMonitored id ["Setup.hs", "Setup.lhs"] >> return ()
  85
  86 needLibrary :: PackageDescription -> Library -> Rebuild ()
  87 needLibrary pkg_descr (Library { exposedModules = modules
  88                                , signatures     = sigs
  89                                , libBuildInfo   = bi })
  90   = needBuildInfo pkg_descr bi (modules ++ sigs)
  91
  92 needForeignLib :: PackageDescription -> ForeignLib -> Rebuild ()
  93 needForeignLib pkg_descr (ForeignLib { foreignLibModDefFile = fs
  94                                      , foreignLibBuildInfo = bi })
  95   = do traverse_ needIfExists fs
  96        needBuildInfo pkg_descr bi []
  97
  98 needExecutable :: PackageDescription -> Executable -> Rebuild ()
  99 needExecutable pkg_descr (Executable { modulePath = mainPath
 100                                      , buildInfo  = bi })
 101   = do needBuildInfo pkg_descr bi []
 102        needMainFile  bi mainPath
 103
 104 needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
 105 needTestSuite pkg_descr t
 106   = case testInterface t of
 107       TestSuiteExeV10 _ mainPath -> do
 108         needBuildInfo pkg_descr bi []
 109         needMainFile  bi mainPath
 110       TestSuiteLibV09 _ m ->
 111         needBuildInfo pkg_descr bi [m]
 112       TestSuiteUnsupported _ -> return () -- soft fail
 113  where
 114   bi :: BuildInfo
 115   bi = testBuildInfo t
 116
 117 needMainFile :: BuildInfo -> FilePath -> Rebuild ()
 118 needMainFile bi mainPath = do
 119     -- The matter here is subtle.  It might *seem* that we
 120     -- should just search for mainPath, but as per
 121     -- b61cb051f63ed5869b8f4a6af996ff7e833e4b39 'main-is'
 122     -- will actually be the source file AFTER preprocessing,
 123     -- whereas we need to get the file *prior* to preprocessing.
 124     ppFile <- findFileWithExtensionMonitored
 125                 (ppSuffixes knownSuffixHandlers)
 126                 (map getSymbolicPath (hsSourceDirs bi))
 127                 (dropExtension mainPath)
 128     case ppFile of
 129         -- But check the original path in the end, because
 130         -- maybe it's a non-preprocessed file with a non-traditional
 131         -- extension.
 132         Nothing -> findFileMonitored (map getSymbolicPath (hsSourceDirs bi)) mainPath
 133                     >>= maybe (return ()) need
 134         Just pp -> need pp
 135
 136 needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
 137 needBenchmark pkg_descr bm
 138   = case benchmarkInterface bm of
 139      BenchmarkExeV10 _ mainPath -> do
 140        needBuildInfo pkg_descr bi []
 141        needMainFile  bi mainPath
 142      BenchmarkUnsupported _ -> return () -- soft fail
 143  where
 144   bi :: BuildInfo
 145   bi = benchmarkBuildInfo bm
 146
 147 needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
 148 needBuildInfo pkg_descr bi modules = do
 149     -- NB: These are separate because there may be both A.hs and
 150     -- A.hs-boot; need to track both.
 151     findNeededModules ["hs", "lhs", "hsig", "lhsig"]
 152     findNeededModules ["hs-boot", "lhs-boot"]
 153     expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie silent (\ _ _ -> return []) (specVersion pkg_descr) "." fpath
 154     traverse_ needIfExists $ concat
 155         [ cSources bi
 156         , cxxSources bi
 157         , jsSources bi
 158         , cmmSources bi
 159         , asmSources bi
 160         , expandedExtraSrcFiles
 161         ]
 162     for_ (installIncludes bi) $ \f ->
 163         findFileMonitored ("." : includeDirs bi) f
 164             >>= maybe (return ()) need
 165   where
 166     findNeededModules :: [String] -> Rebuild ()
 167     findNeededModules exts = traverse_
 168         (findNeededModule exts)
 169         (modules ++ otherModules bi)
 170     findNeededModule :: [String] -> ModuleName -> Rebuild ()
 171     findNeededModule exts m =
 172         findFileWithExtensionMonitored
 173             (ppSuffixes knownSuffixHandlers ++ exts)
 174             (map getSymbolicPath (hsSourceDirs bi))
 175             (toFilePath m)
 176           >>= maybe (return ()) need