{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}

module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..), buildWayPrefix) where

import Control.Monad.IO.Class
import Distribution.Compat.Prelude

import Data.List (sortOn, (\\))
import qualified Data.Set as Set
import Distribution.CabalSpecVersion
import Distribution.ModuleName (ModuleName)
import qualified Distribution.PackageDescription as PD
import Distribution.Pretty
import Distribution.Simple.Build.Inputs
import Distribution.Simple.Compiler
import Distribution.Simple.GHC.Build.Utils
import qualified Distribution.Simple.GHC.Internal as Internal
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.GHC
import Distribution.Simple.Program.Types
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.Types.Benchmark
import Distribution.Types.BenchmarkInterface
import Distribution.Types.BuildInfo
import Distribution.Types.Executable
import Distribution.Types.ForeignLib
import Distribution.Types.PackageName.Magic
import Distribution.Types.ParStrat
import Distribution.Types.TestSuite
import Distribution.Types.TestSuiteInterface
import Distribution.Utils.NubList
import System.FilePath

{-
Note [Building Haskell Modules accounting for TH]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

There are multiple ways in which we may want to build our Haskell modules:
  * The static way (-static)
  * The dynamic/shared way (-dynamic)
  * The profiled way (-prof)

For libraries, we may /want/ to build modules in all three ways, or in any combination, depending on user options.
For executables, we just /want/ to build the executable in the requested way.

In practice, however, we may /need/ to build modules in additional ways beyonds the ones that were requested.
This can happen because of Template Haskell.

When we're using Template Haskell, we /need/ to additionally build modules with
the used GHC's default/vanilla ABI. This is because the code that TH needs to
run at compile time needs to be the vanilla ABI so it can be loaded up and run
by the compiler. With dynamic-by-default GHC the TH object files loaded at
compile-time need to be .dyn_o instead of .o.

  * If the GHC is dynamic by default, that means we may need to also build
  the dynamic way in addition the wanted way.

  * If the GHC is static by default, we may need to build statically additionally.

Of course, if the /wanted/ way is the way additionally /needed/ for TH, we don't need to do extra work.

If it turns out that in the end we need to build both statically and
dynamically, we want to make use of GHC's -static -dynamic-too capability, which
builds modules in the two ways in a single invocation.

If --dynamic-too is not supported by the GHC, then we need to be careful about
the order in which modules are built. Specifically, we must first build the
modules for TH with the vanilla ABI, and only afterwards the desired
(non-default) ways.

A few examples:

To build an executable with profiling, with a dynamic by default GHC, and TH is used:
  * Build dynamic (needed) objects
  * Build profiled objects

To build a library with profiling and dynamically, with a static by default GHC, and TH is used:
  * Build dynamic (wanted) and static (needed) objects together with --dynamic-too
  * Build profiled objects

To build an executable statically, with a static by default GHC, regardless of whether TH is used:
  * Simply build static objects

-}

-- | Compile the Haskell modules of the component being built.
buildHaskellModules
  :: Flag ParStrat
  -- ^ The parallelism strategy (e.g. num of jobs)
  -> ConfiguredProgram
  -- ^ The GHC configured program
  -> PD.PackageDescription
  -- ^ The package description
  -> FilePath
  -- ^ The path to the build directory for this target, which
  -- has already been created.
  -> Set.Set BuildWay
  -- ^ The set of wanted build ways according to user options
  -> PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> IO (BuildWay -> GhcOptions)
  -- ^ Returns a mapping from build ways to the 'GhcOptions' used in the
  -- invocation used to compile the component in that 'BuildWay'.
  -- This can be useful in, eg, a linker invocation, in which we want to use the
  -- same options and list the same inputs as those used for building.
buildHaskellModules :: Flag ParStrat
-> ConfiguredProgram
-> PackageDescription
-> FilePath
-> Set BuildWay
-> PreBuildComponentInputs
-> IO (BuildWay -> GhcOptions)
buildHaskellModules Flag ParStrat
numJobs ConfiguredProgram
ghcProg PackageDescription
pkg_descr FilePath
buildTargetDir Set BuildWay
wantedWays PreBuildComponentInputs
pbci = do
  -- See Note [Building Haskell Modules accounting for TH]

  let
    verbosity :: Verbosity
verbosity = PreBuildComponentInputs -> Verbosity
buildVerbosity PreBuildComponentInputs
pbci
    isLib :: Bool
isLib = PreBuildComponentInputs -> Bool
buildIsLib PreBuildComponentInputs
pbci
    clbi :: ComponentLocalBuildInfo
clbi = PreBuildComponentInputs -> ComponentLocalBuildInfo
buildCLBI PreBuildComponentInputs
pbci
    lbi :: LocalBuildInfo
lbi = PreBuildComponentInputs -> LocalBuildInfo
localBuildInfo PreBuildComponentInputs
pbci
    bi :: BuildInfo
bi = PreBuildComponentInputs -> BuildInfo
buildBI PreBuildComponentInputs
pbci
    what :: BuildingWhat
what = PreBuildComponentInputs -> BuildingWhat
buildingWhat PreBuildComponentInputs
pbci
    comp :: Compiler
comp = PreBuildComponentInputs -> Compiler
buildCompiler PreBuildComponentInputs
pbci

    -- If this component will be loaded into a repl, we don't compile the modules at all.
    forRepl :: Bool
forRepl
      | BuildRepl{} <- BuildingWhat
what = Bool
True
      | Bool
otherwise = Bool
False

  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?  FIX: what about exeName.hi-boot?

  -- Determine if program coverage should be enabled and if so, what
  -- '-hpcdir' should be.
  let isCoverageEnabled :: Bool
isCoverageEnabled = if Bool
isLib then LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi else LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
      hpcdir :: Way -> Flag FilePath
hpcdir Way
way
        | Bool
forRepl = Flag FilePath
forall a. Monoid a => a
mempty -- HPC is not supported in ghci
        | Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
Flag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath
Hpc.mixDir (FilePath
buildTargetDir FilePath -> FilePath -> FilePath
</> FilePath
extraCompilationArtifacts) Way
way
        | Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty

  (inputFiles, inputModules) <- FilePath
-> PackageDescription
-> PreBuildComponentInputs
-> IO ([FilePath], [ModuleName])
componentInputs FilePath
buildTargetDir PackageDescription
pkg_descr PreBuildComponentInputs
pbci

  let
    runGhcProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform
    platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi

    -- See Note [Building Haskell Modules accounting for TH]
    doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
bi

    -- We define the base opts which are shared across different build ways in
    -- 'buildHaskellModules'
    baseOpts BuildWay
way =
      (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi FilePath
buildTargetDir)
        GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
          { ghcOptMode = toFlag GhcModeMake
          , -- Previously we didn't pass -no-link when building libs,
            -- but I think that could result in a bug (e.g. if a lib module is
            -- called Main and exports main). So we really want nolink when
            -- building libs too (TODO).
            ghcOptNoLink = if isLib then NoFlag else toFlag True
          , ghcOptNumJobs = numJobs
          , ghcOptInputModules = toNubListR inputModules
          , ghcOptInputFiles =
              toNubListR $
                if PD.package pkg_descr == fakePackageId
                  then filter isHaskell inputFiles
                  else inputFiles
          , ghcOptInputScripts =
              toNubListR $
                if PD.package pkg_descr == fakePackageId
                  then filter (not . isHaskell) inputFiles
                  else []
          , ghcOptExtra = buildWayExtraHcOptions way GHC bi
          , ghcOptHiSuffix = optSuffixFlag (buildWayPrefix way) "hi"
          , ghcOptObjSuffix = optSuffixFlag (buildWayPrefix way) "o"
          , ghcOptHPCDir = hpcdir (buildWayHpcWay way) -- maybe this should not be passed for vanilla?
          }
      where
        optSuffixFlag :: FilePath -> FilePath -> Flag FilePath
optSuffixFlag FilePath
"" FilePath
_ = Flag FilePath
forall a. Flag a
NoFlag
        optSuffixFlag FilePath
pre FilePath
x = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath
pre FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x)

    -- For libs we don't pass -static when building static, leaving it
    -- implicit. We should just always pass -static, but we don't want to
    -- change behaviour when doing the refactor.
    staticOpts = (BuildWay -> GhcOptions
baseOpts BuildWay
StaticWay){ghcOptDynLinkMode = if isLib then NoFlag else toFlag GhcStaticOnly}
    dynOpts =
      (BuildWay -> GhcOptions
baseOpts BuildWay
DynWay)
        { ghcOptDynLinkMode = toFlag GhcDynamicOnly -- use -dynamic
        , -- TODO: Does it hurt to set -fPIC for executables?
          ghcOptFPic = toFlag True -- use -fPIC
        }
    profOpts =
      (BuildWay -> GhcOptions
baseOpts BuildWay
ProfWay)
        { ghcOptProfilingMode = toFlag True
        , ghcOptProfilingAuto =
            Internal.profDetailLevelFlag
              (if isLib then True else False)
              ((if isLib then withProfLibDetail else withProfExeDetail) lbi)
        }
    -- Options for building both static and dynamic way at the same time, using
    -- the GHC flag -static and -dynamic-too
    dynTooOpts =
      (BuildWay -> GhcOptions
baseOpts BuildWay
StaticWay)
        { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic -- use -dynamic-too
        , ghcOptDynHiSuffix = toFlag (buildWayPrefix DynWay ++ "hi")
        , ghcOptDynObjSuffix = toFlag (buildWayPrefix DynWay ++ "o")
        , ghcOptHPCDir = hpcdir Hpc.Dyn
        -- Should we pass hcSharedOpts in the -dynamic-too ghc invocation?
        -- (Note that `baseOtps StaticWay = hcStaticOptions`, not hcSharedOpts)
        }

    -- Determines how to build for each way, also serves as the base options
    -- for loading modules in 'linkOrLoadComponent'
    buildOpts BuildWay
way = case BuildWay
way of
      BuildWay
StaticWay -> GhcOptions
staticOpts
      BuildWay
DynWay -> GhcOptions
dynOpts
      BuildWay
ProfWay -> GhcOptions
profOpts

    defaultGhcWay = if Compiler -> Bool
isDynamic Compiler
comp then BuildWay
DynWay else BuildWay
StaticWay

  -- If there aren't modules, or if we're loading the modules in repl, don't build.
  unless (forRepl || (null inputFiles && null inputModules)) $ liftIO $ do
    -- See Note [Building Haskell Modules accounting for TH]
    let
      neededWays =
        Set BuildWay
wantedWays
          Set BuildWay -> Set BuildWay -> Set BuildWay
forall a. Semigroup a => a -> a -> a
<> [BuildWay] -> Set BuildWay
forall a. Ord a => [a] -> Set a
Set.fromList
            -- TODO: You also don't need to build the GHC way when doing TH if
            -- you are using an external interpreter!!
            [BuildWay
defaultGhcWay | Bool
doingTH Bool -> Bool -> Bool
&& BuildWay
defaultGhcWay BuildWay -> Set BuildWay -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set BuildWay
wantedWays]

      -- If we need both static and dynamic, use dynamic-too instead of
      -- compiling twice (if we support it)
      useDynamicToo =
        BuildWay
StaticWay BuildWay -> Set BuildWay -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BuildWay
neededWays
          Bool -> Bool -> Bool
&& BuildWay
DynWay BuildWay -> Set BuildWay -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set BuildWay
neededWays
          Bool -> Bool -> Bool
&& Compiler -> Bool
supportsDynamicToo Compiler
comp
          Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi)

      -- The ways we'll build, in order
      orderedBuilds
        -- If we can use dynamic-too, do it first. The default GHC way can only
        -- be static or dynamic, so, if we build both right away, any modules
        -- possibly needed by TH later (e.g. if building profiled) are already built.
        | Bool
useDynamicToo =
            [IO ()
buildStaticAndDynamicToo]
              [IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++ (GhcOptions -> IO ()
runGhcProg (GhcOptions -> IO ())
-> (BuildWay -> GhcOptions) -> BuildWay -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildWay -> GhcOptions
buildOpts (BuildWay -> IO ()) -> [BuildWay] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set BuildWay -> [BuildWay]
forall a. Set a -> [a]
Set.toList Set BuildWay
neededWays [BuildWay] -> [BuildWay] -> [BuildWay]
forall a. Eq a => [a] -> [a] -> [a]
\\ [BuildWay
StaticWay, BuildWay
DynWay])
        -- Otherwise, we need to ensure the defaultGhcWay is built first
        | Bool
otherwise =
            GhcOptions -> IO ()
runGhcProg (GhcOptions -> IO ())
-> (BuildWay -> GhcOptions) -> BuildWay -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildWay -> GhcOptions
buildOpts (BuildWay -> IO ()) -> [BuildWay] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BuildWay -> Int) -> [BuildWay] -> [BuildWay]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\BuildWay
w -> if BuildWay
w BuildWay -> BuildWay -> Bool
forall a. Eq a => a -> a -> Bool
== BuildWay
defaultGhcWay then Int
0 else BuildWay -> Int
forall a. Enum a => a -> Int
fromEnum BuildWay
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Set BuildWay -> [BuildWay]
forall a. Set a -> [a]
Set.toList Set BuildWay
neededWays)

      buildStaticAndDynamicToo = do
        GhcOptions -> IO ()
runGhcProg GhcOptions
dynTooOpts
        case (Way -> Flag FilePath
hpcdir Way
Hpc.Dyn, Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla) of
          (Flag FilePath
dynDir, Flag FilePath
vanillaDir) ->
            -- When the vanilla and shared library builds are done
            -- in one pass, only one set of HPC module interfaces
            -- are generated. This set should suffice for both
            -- static and dynamically linked executables. We copy
            -- the modules interfaces so they are available under
            -- both ways.
            Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive Verbosity
verbosity FilePath
dynDir FilePath
vanillaDir
          (Flag FilePath, Flag FilePath)
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in
      -- REVIEW:ADD? info verbosity "Building Haskell Sources..."
      sequence_ orderedBuilds
  return buildOpts

data BuildWay = StaticWay | DynWay | ProfWay
  deriving (BuildWay -> BuildWay -> Bool
(BuildWay -> BuildWay -> Bool)
-> (BuildWay -> BuildWay -> Bool) -> Eq BuildWay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildWay -> BuildWay -> Bool
== :: BuildWay -> BuildWay -> Bool
$c/= :: BuildWay -> BuildWay -> Bool
/= :: BuildWay -> BuildWay -> Bool
Eq, Eq BuildWay
Eq BuildWay =>
(BuildWay -> BuildWay -> Ordering)
-> (BuildWay -> BuildWay -> Bool)
-> (BuildWay -> BuildWay -> Bool)
-> (BuildWay -> BuildWay -> Bool)
-> (BuildWay -> BuildWay -> Bool)
-> (BuildWay -> BuildWay -> BuildWay)
-> (BuildWay -> BuildWay -> BuildWay)
-> Ord BuildWay
BuildWay -> BuildWay -> Bool
BuildWay -> BuildWay -> Ordering
BuildWay -> BuildWay -> BuildWay
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BuildWay -> BuildWay -> Ordering
compare :: BuildWay -> BuildWay -> Ordering
$c< :: BuildWay -> BuildWay -> Bool
< :: BuildWay -> BuildWay -> Bool
$c<= :: BuildWay -> BuildWay -> Bool
<= :: BuildWay -> BuildWay -> Bool
$c> :: BuildWay -> BuildWay -> Bool
> :: BuildWay -> BuildWay -> Bool
$c>= :: BuildWay -> BuildWay -> Bool
>= :: BuildWay -> BuildWay -> Bool
$cmax :: BuildWay -> BuildWay -> BuildWay
max :: BuildWay -> BuildWay -> BuildWay
$cmin :: BuildWay -> BuildWay -> BuildWay
min :: BuildWay -> BuildWay -> BuildWay
Ord, Int -> BuildWay -> FilePath -> FilePath
[BuildWay] -> FilePath -> FilePath
BuildWay -> FilePath
(Int -> BuildWay -> FilePath -> FilePath)
-> (BuildWay -> FilePath)
-> ([BuildWay] -> FilePath -> FilePath)
-> Show BuildWay
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> BuildWay -> FilePath -> FilePath
showsPrec :: Int -> BuildWay -> FilePath -> FilePath
$cshow :: BuildWay -> FilePath
show :: BuildWay -> FilePath
$cshowList :: [BuildWay] -> FilePath -> FilePath
showList :: [BuildWay] -> FilePath -> FilePath
Show, Int -> BuildWay
BuildWay -> Int
BuildWay -> [BuildWay]
BuildWay -> BuildWay
BuildWay -> BuildWay -> [BuildWay]
BuildWay -> BuildWay -> BuildWay -> [BuildWay]
(BuildWay -> BuildWay)
-> (BuildWay -> BuildWay)
-> (Int -> BuildWay)
-> (BuildWay -> Int)
-> (BuildWay -> [BuildWay])
-> (BuildWay -> BuildWay -> [BuildWay])
-> (BuildWay -> BuildWay -> [BuildWay])
-> (BuildWay -> BuildWay -> BuildWay -> [BuildWay])
-> Enum BuildWay
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BuildWay -> BuildWay
succ :: BuildWay -> BuildWay
$cpred :: BuildWay -> BuildWay
pred :: BuildWay -> BuildWay
$ctoEnum :: Int -> BuildWay
toEnum :: Int -> BuildWay
$cfromEnum :: BuildWay -> Int
fromEnum :: BuildWay -> Int
$cenumFrom :: BuildWay -> [BuildWay]
enumFrom :: BuildWay -> [BuildWay]
$cenumFromThen :: BuildWay -> BuildWay -> [BuildWay]
enumFromThen :: BuildWay -> BuildWay -> [BuildWay]
$cenumFromTo :: BuildWay -> BuildWay -> [BuildWay]
enumFromTo :: BuildWay -> BuildWay -> [BuildWay]
$cenumFromThenTo :: BuildWay -> BuildWay -> BuildWay -> [BuildWay]
enumFromThenTo :: BuildWay -> BuildWay -> BuildWay -> [BuildWay]
Enum)

-- | Returns the object/interface extension prefix for the given build way (e.g. "dyn_" for 'DynWay')
buildWayPrefix :: BuildWay -> String
buildWayPrefix :: BuildWay -> FilePath
buildWayPrefix = \case
  BuildWay
StaticWay -> FilePath
""
  BuildWay
ProfWay -> FilePath
"p_"
  BuildWay
DynWay -> FilePath
"dyn_"

-- | Returns the corresponding 'Hpc.Way' for a 'BuildWay'
buildWayHpcWay :: BuildWay -> Hpc.Way
buildWayHpcWay :: BuildWay -> Way
buildWayHpcWay = \case
  BuildWay
StaticWay -> Way
Hpc.Vanilla
  BuildWay
ProfWay -> Way
Hpc.Prof
  BuildWay
DynWay -> Way
Hpc.Dyn

-- | Returns a function to extract the extra haskell compiler options from a
-- 'BuildInfo' and 'CompilerFlavor'
buildWayExtraHcOptions :: BuildWay -> CompilerFlavor -> BuildInfo -> [String]
buildWayExtraHcOptions :: BuildWay -> CompilerFlavor -> BuildInfo -> [FilePath]
buildWayExtraHcOptions = \case
  BuildWay
StaticWay -> CompilerFlavor -> BuildInfo -> [FilePath]
hcStaticOptions
  BuildWay
ProfWay -> CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions
  BuildWay
DynWay -> CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions

-- | Returns a pair of the Haskell input files and Haskell modules of the
-- component being built.
--
-- The "input files" are either the path to the main Haskell module, or a repl
-- script (that does not necessarily have an extension).
componentInputs
  :: FilePath
  -- ^ Target build dir
  -> PD.PackageDescription
  -> PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> IO ([FilePath], [ModuleName])
  -- ^ The Haskell input files, and the Haskell modules
componentInputs :: FilePath
-> PackageDescription
-> PreBuildComponentInputs
-> IO ([FilePath], [ModuleName])
componentInputs FilePath
buildTargetDir PackageDescription
pkg_descr PreBuildComponentInputs
pbci = do
  let
    verbosity :: Verbosity
verbosity = PreBuildComponentInputs -> Verbosity
buildVerbosity PreBuildComponentInputs
pbci
    component :: Component
component = PreBuildComponentInputs -> Component
buildComponent PreBuildComponentInputs
pbci
    clbi :: ComponentLocalBuildInfo
clbi = PreBuildComponentInputs -> ComponentLocalBuildInfo
buildCLBI PreBuildComponentInputs
pbci

  case Component
component of
    CLib Library
lib ->
      ([FilePath], [ModuleName]) -> IO ([FilePath], [ModuleName])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
    CFLib ForeignLib
flib ->
      ([FilePath], [ModuleName]) -> IO ([FilePath], [ModuleName])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib)
    CExe Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bi', FilePath
modulePath :: FilePath
modulePath :: Executable -> FilePath
modulePath} ->
      Verbosity -> BuildInfo -> FilePath -> IO ([FilePath], [ModuleName])
forall {m :: * -> *}.
MonadIO m =>
Verbosity -> BuildInfo -> FilePath -> m ([FilePath], [ModuleName])
exeLikeInputs Verbosity
verbosity BuildInfo
bi' FilePath
modulePath
    CTest TestSuite{testBuildInfo :: TestSuite -> BuildInfo
testBuildInfo = BuildInfo
bi', testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10 Version
_ FilePath
mainFile} ->
      Verbosity -> BuildInfo -> FilePath -> IO ([FilePath], [ModuleName])
forall {m :: * -> *}.
MonadIO m =>
Verbosity -> BuildInfo -> FilePath -> m ([FilePath], [ModuleName])
exeLikeInputs Verbosity
verbosity BuildInfo
bi' FilePath
mainFile
    CBench Benchmark{benchmarkBuildInfo :: Benchmark -> BuildInfo
benchmarkBuildInfo = BuildInfo
bi', benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10 Version
_ FilePath
mainFile} ->
      Verbosity -> BuildInfo -> FilePath -> IO ([FilePath], [ModuleName])
forall {m :: * -> *}.
MonadIO m =>
Verbosity -> BuildInfo -> FilePath -> m ([FilePath], [ModuleName])
exeLikeInputs Verbosity
verbosity BuildInfo
bi' FilePath
mainFile
    CTest TestSuite{} -> FilePath -> IO ([FilePath], [ModuleName])
forall a. HasCallStack => FilePath -> a
error FilePath
"testSuiteExeV10AsExe: wrong kind"
    CBench Benchmark{} -> FilePath -> IO ([FilePath], [ModuleName])
forall a. HasCallStack => FilePath -> a
error FilePath
"benchmarkExeV10asExe: wrong kind"
  where
    exeLikeInputs :: Verbosity -> BuildInfo -> FilePath -> m ([FilePath], [ModuleName])
exeLikeInputs Verbosity
verbosity BuildInfo
bnfo FilePath
modulePath = IO ([FilePath], [ModuleName]) -> m ([FilePath], [ModuleName])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FilePath], [ModuleName]) -> m ([FilePath], [ModuleName]))
-> IO ([FilePath], [ModuleName]) -> m ([FilePath], [ModuleName])
forall a b. (a -> b) -> a -> b
$ do
      main <- Verbosity -> FilePath -> (BuildInfo, FilePath) -> IO FilePath
findExecutableMain Verbosity
verbosity FilePath
buildTargetDir (BuildInfo
bnfo, FilePath
modulePath)
      let mainModName = BuildInfo -> ModuleName
exeMainModuleName BuildInfo
bnfo
          otherModNames = BuildInfo -> [ModuleName]
otherModules BuildInfo
bnfo

      -- Scripts have fakePackageId and are always Haskell but can have any extension.
      if isHaskell main || PD.package pkg_descr == fakePackageId
        then
          if PD.specVersion pkg_descr < CabalSpecV2_0 && (mainModName `elem` otherModNames)
            then do
              -- The cabal manual clearly states that `other-modules` is
              -- intended for non-main modules.  However, there's at least one
              -- important package on Hackage (happy-1.19.5) which
              -- violates this. We workaround this here so that we don't
              -- invoke GHC with e.g.  'ghc --make Main src/Main.hs' which
              -- would result in GHC complaining about duplicate Main
              -- modules.
              --
              -- Finally, we only enable this workaround for
              -- specVersion < 2, as 'cabal-version:>=2.0' cabal files
              -- have no excuse anymore to keep doing it wrong... ;-)
              warn verbosity $
                "Enabling workaround for Main module '"
                  ++ prettyShow mainModName
                  ++ "' listed in 'other-modules' illegally!"
              return ([main], filter (/= mainModName) otherModNames)
            else return ([main], otherModNames)
        else return ([], otherModNames)