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.Benchmark
  26 import Distribution.Types.BenchmarkInterface
  27 import Distribution.Types.BuildInfo
  28 import Distribution.Types.Component
  29 import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec)
  30 import Distribution.Types.Executable
  31 import Distribution.Types.ForeignLib
  32 import Distribution.Types.Library
  33 import Distribution.Types.PackageDescription
  34 import Distribution.Types.TestSuite
  35 import Distribution.Types.TestSuiteInterface
  36 import Distribution.Utils.Path
  37
  38 import Distribution.ModuleName
  39
  40 import Distribution.Client.Compat.Prelude
  41 import Distribution.Verbosity (normal)
  42 import Prelude ()
  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
  88   pkg_descr
  89   ( Library
  90       { exposedModules = modules
  91       , signatures = sigs
  92       , libBuildInfo = bi
  93       }
  94     ) =
  95     needBuildInfo pkg_descr bi (modules ++ sigs)
  96
  97 needForeignLib :: PackageDescription -> ForeignLib -> Rebuild ()
  98 needForeignLib
  99   pkg_descr
 100   ( ForeignLib
 101       { foreignLibModDefFile = fs
 102       , foreignLibBuildInfo = bi
 103       }
 104     ) =
 105     do
 106       traverse_ needIfExists fs
 107       needBuildInfo pkg_descr bi []
 108
 109 needExecutable :: PackageDescription -> Executable -> Rebuild ()
 110 needExecutable
 111   pkg_descr
 112   ( Executable
 113       { modulePath = mainPath
 114       , buildInfo = bi
 115       }
 116     ) =
 117     do
 118       needBuildInfo pkg_descr bi []
 119       needMainFile bi mainPath
 120
 121 needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
 122 needTestSuite pkg_descr t =
 123   case testInterface t of
 124     TestSuiteExeV10 _ mainPath -> do
 125       needBuildInfo pkg_descr bi []
 126       needMainFile bi mainPath
 127     TestSuiteLibV09 _ m ->
 128       needBuildInfo pkg_descr bi [m]
 129     TestSuiteUnsupported _ -> return () -- soft fail
 130   where
 131     bi :: BuildInfo
 132     bi = testBuildInfo t
 133
 134 needMainFile :: BuildInfo -> FilePath -> Rebuild ()
 135 needMainFile bi mainPath = do
 136   -- The matter here is subtle.  It might *seem* that we
 137   -- should just search for mainPath, but as per
 138   -- b61cb051f63ed5869b8f4a6af996ff7e833e4b39 'main-is'
 139   -- will actually be the source file AFTER preprocessing,
 140   -- whereas we need to get the file *prior* to preprocessing.
 141   ppFile <-
 142     findFileWithExtensionMonitored
 143       (ppSuffixes knownSuffixHandlers)
 144       (map getSymbolicPath (hsSourceDirs bi))
 145       (dropExtension mainPath)
 146   case ppFile of
 147     -- But check the original path in the end, because
 148     -- maybe it's a non-preprocessed file with a non-traditional
 149     -- extension.
 150     Nothing ->
 151       findFileMonitored (map getSymbolicPath (hsSourceDirs bi)) mainPath
 152         >>= maybe (return ()) need
 153     Just pp -> need pp
 154
 155 needBenchmark :: PackageDescription -> Benchmark -> Rebuild ()
 156 needBenchmark pkg_descr bm =
 157   case benchmarkInterface bm of
 158     BenchmarkExeV10 _ mainPath -> do
 159       needBuildInfo pkg_descr bi []
 160       needMainFile bi mainPath
 161     BenchmarkUnsupported _ -> return () -- soft fail
 162   where
 163     bi :: BuildInfo
 164     bi = benchmarkBuildInfo bm
 165
 166 needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
 167 needBuildInfo pkg_descr bi modules = do
 168   -- NB: These are separate because there may be both A.hs and
 169   -- A.hs-boot; need to track both.
 170   findNeededModules ["hs", "lhs", "hsig", "lhsig"]
 171   findNeededModules ["hs-boot", "lhs-boot"]
 172   root <- askRoot
 173   expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) root fpath
 174   traverse_ needIfExists $
 175     concat
 176       [ cSources bi
 177       , cxxSources bi
 178       , jsSources bi
 179       , cmmSources bi
 180       , asmSources bi
 181       , expandedExtraSrcFiles
 182       ]
 183   for_ (installIncludes bi) $ \f ->
 184     findFileMonitored ("." : includeDirs bi) f
 185       >>= maybe (return ()) need
 186   where
 187     findNeededModules :: [String] -> Rebuild ()
 188     findNeededModules exts =
 189       traverse_
 190         (findNeededModule exts)
 191         (modules ++ otherModules bi)
 192     findNeededModule :: [String] -> ModuleName -> Rebuild ()
 193     findNeededModule exts m =
 194       findFileWithExtensionMonitored
 195         (ppSuffixes knownSuffixHandlers ++ exts)
 196         (map getSymbolicPath (hsSourceDirs bi))
 197         (toFilePath m)
 198         >>= maybe (return ()) need