SourceFiles.hs

-- | 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.Benchmark
import Distribution.Types.BenchmarkInterface
import Distribution.Types.BuildInfo
import Distribution.Types.Component
import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec)
import Distribution.Types.Executable
import Distribution.Types.ForeignLib
import Distribution.Types.Library
import Distribution.Types.PackageDescription
import Distribution.Types.TestSuite
import Distribution.Types.TestSuiteInterface
import Distribution.Utils.Path

import Distribution.ModuleName

import Distribution.Client.Compat.Prelude
import Distribution.Verbosity (normal)
import Prelude ()

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 . getSymbolicPath) fs
      needBuildInfo pkg_descr bi []

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

needTestSuite :: PackageDescription -> TestSuite -> Rebuild ()
needTestSuite pkg_descr t =
  case testInterface t of
    TestSuiteExeV10 _ mainPath -> do
      needBuildInfo pkg_descr bi []
      needMainFile bi $ getSymbolicPath 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 $ getSymbolicPath 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 builtinHaskellSuffixes
  findNeededModules builtinHaskellBootSuffixes
  root <- askRoot
  expandedExtraSrcFiles <- liftIO $
    fmap concat . for (extraSrcFiles pkg_descr) $
      \fpath ->
        matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) (Just $ makeSymbolicPath root) fpath
  traverse_ needIfExists $
    concat
      [ map getSymbolicPath $ cSources bi
      , map getSymbolicPath $ cxxSources bi
      , map getSymbolicPath $ jsSources bi
      , map getSymbolicPath $ cmmSources bi
      , map getSymbolicPath $ asmSources bi
      , map getSymbolicPath $ expandedExtraSrcFiles
      ]
  for_ (fmap getSymbolicPath $ installIncludes bi) $ \f ->
    findFileMonitored ("." : fmap getSymbolicPath (includeDirs bi)) f
      >>= maybe (return ()) need
  where
    findNeededModules :: [Suffix] -> Rebuild ()
    findNeededModules exts =
      traverse_
        (findNeededModule exts)
        (modules ++ otherModules bi)
    findNeededModule :: [Suffix] -> ModuleName -> Rebuild ()
    findNeededModule exts m =
      findFileWithExtensionMonitored
        (ppSuffixes knownSuffixHandlers ++ exts)
        (map getSymbolicPath (hsSourceDirs bi))
        (toFilePath m)
        >>= maybe (return ()) need