{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

module Distribution.Simple.GHC.Build.ExtraSources where

import Control.Monad
import Data.Foldable
import Distribution.Simple.Flag
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.Program.GHC
import Distribution.Simple.Utils
import Distribution.Utils.NubList

import Distribution.Types.BuildInfo
import Distribution.Types.Component
import Distribution.Types.TargetInfo

import Distribution.Simple.Build.Inputs
import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.System (Arch (JavaScript), Platform (..))
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.Executable
import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)

-- | An action that builds all the extra build sources of a component, i.e. C,
-- C++, Js, Asm, C-- sources.
buildAllExtraSources
  :: ConfiguredProgram
  -- ^ The GHC configured program
  -> SymbolicPath Pkg (Dir Artifacts)
  -- ^ The build directory for this target
  -> PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> IO (NubListR (SymbolicPath Pkg File))
  -- ^ Returns the (nubbed) list of extra sources that were built
buildAllExtraSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAllExtraSources =
  [ConfiguredProgram
 -> SymbolicPath Pkg ('Dir Artifacts)
 -> PreBuildComponentInputs
 -> IO (NubListR (SymbolicPath Pkg 'File))]
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
forall a. Monoid a => [a] -> a
mconcat
    [ ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCSources
    , ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCxxSources
    , ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildJsSources
    , ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAsmSources
    , ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCmmSources
    ]

buildCSources
  , buildCxxSources
  , buildJsSources
  , buildAsmSources
  , buildCmmSources
    :: ConfiguredProgram
    -- ^ The GHC configured program
    -> SymbolicPath Pkg (Dir Artifacts)
    -- ^ The build directory for this target
    -> PreBuildComponentInputs
    -- ^ The context and component being built in it.
    -> IO (NubListR (SymbolicPath Pkg File))
    -- ^ Returns the list of extra sources that were built
buildCSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCSources =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCcGhcOptions
    Bool
True
    ( \Component
c -> do
        let cFiles :: [SymbolicPath Pkg 'File]
cFiles = BuildInfo -> [SymbolicPath Pkg 'File]
cSources (Component -> BuildInfo
componentBuildInfo Component
c)
        case Component
c of
          CExe Executable
exe
            | let mainPath :: String
mainPath = SymbolicPathX 'OnlyRelative Source 'File -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath (SymbolicPathX 'OnlyRelative Source 'File -> String)
-> SymbolicPathX 'OnlyRelative Source 'File -> String
forall a b. (a -> b) -> a -> b
$ Executable -> SymbolicPathX 'OnlyRelative Source 'File
modulePath Executable
exe
            , String -> Bool
isC String
mainPath ->
                [SymbolicPath Pkg 'File]
cFiles [SymbolicPath Pkg 'File]
-> [SymbolicPath Pkg 'File] -> [SymbolicPath Pkg 'File]
forall a. [a] -> [a] -> [a]
++ [String -> SymbolicPath Pkg 'File
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
mainPath]
          -- NB: Main.hs is relative to hs-source-dirs, but Main.c
          -- is relative to the package.
          Component
_otherwise -> [SymbolicPath Pkg 'File]
cFiles
    )
buildCxxSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCxxSources =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C++ Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCxxGhcOptions
    Bool
True
    ( \Component
c -> do
        let cxxFiles :: [SymbolicPath Pkg 'File]
cxxFiles = BuildInfo -> [SymbolicPath Pkg 'File]
cxxSources (Component -> BuildInfo
componentBuildInfo Component
c)
        case Component
c of
          CExe Executable
exe
            | let mainPath :: String
mainPath = SymbolicPathX 'OnlyRelative Source 'File -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath (SymbolicPathX 'OnlyRelative Source 'File -> String)
-> SymbolicPathX 'OnlyRelative Source 'File -> String
forall a b. (a -> b) -> a -> b
$ Executable -> SymbolicPathX 'OnlyRelative Source 'File
modulePath Executable
exe
            , String -> Bool
isCxx String
mainPath ->
                do [SymbolicPath Pkg 'File]
cxxFiles [SymbolicPath Pkg 'File]
-> [SymbolicPath Pkg 'File] -> [SymbolicPath Pkg 'File]
forall a. [a] -> [a] -> [a]
++ [String -> SymbolicPath Pkg 'File
forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
mainPath]
          -- NB: Main.hs is relative to hs-source-dirs, but Main.c++
          -- is relative to the package.
          Component
_otherwise -> [SymbolicPath Pkg 'File]
cxxFiles
    )
buildJsSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildJsSources ConfiguredProgram
ghcProg SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir = do
  Platform Arch
hostArch OS
_ <- LocalBuildInfo -> Platform
hostPlatform (LocalBuildInfo -> Platform)
-> (PreBuildComponentInputs -> LocalBuildInfo)
-> PreBuildComponentInputs
-> Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreBuildComponentInputs -> LocalBuildInfo
localBuildInfo
  let hasJsSupport :: Bool
hasJsSupport = Arch
hostArch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
JavaScript
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"JS Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentJsGhcOptions
    Bool
False
    ( \Component
c ->
        if Bool
hasJsSupport
          then -- JS files are C-like with GHC's JS backend: they are
          -- "compiled" into `.o` files (renamed with a header).
          -- This is a difference from GHCJS, for which we only
          -- pass the JS files at link time.
            BuildInfo -> [SymbolicPath Pkg 'File]
jsSources (Component -> BuildInfo
componentBuildInfo Component
c)
          else [SymbolicPath Pkg 'File]
forall a. Monoid a => a
mempty
    )
    ConfiguredProgram
ghcProg
    SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
buildAsmSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAsmSources =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"Assembler Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentAsmGhcOptions
    Bool
True
    (BuildInfo -> [SymbolicPath Pkg 'File]
asmSources (BuildInfo -> [SymbolicPath Pkg 'File])
-> (Component -> BuildInfo)
-> Component
-> [SymbolicPath Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> BuildInfo
componentBuildInfo)
buildCmmSources :: ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCmmSources =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C-- Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCmmGhcOptions
    Bool
True
    (BuildInfo -> [SymbolicPath Pkg 'File]
cmmSources (BuildInfo -> [SymbolicPath Pkg 'File])
-> (Component -> BuildInfo)
-> Component
-> [SymbolicPath Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component -> BuildInfo
componentBuildInfo)

-- | Create 'PreBuildComponentRules' for a given type of extra build sources
-- which are compiled via a GHC invocation with the given options. Used to
-- define built-in extra sources, such as, C, Cxx, Js, Asm, and Cmm sources.
buildExtraSources
  :: String
  -- ^ String describing the extra sources being built, for printing.
  -> ( Verbosity
       -> LocalBuildInfo
       -> BuildInfo
       -> ComponentLocalBuildInfo
       -> SymbolicPath Pkg (Dir Artifacts)
       -> SymbolicPath Pkg File
       -> GhcOptions
     )
  -- ^ Function to determine the @'GhcOptions'@ for the
  -- invocation of GHC when compiling these extra sources (e.g.
  -- @'Internal.componentCxxGhcOptions'@,
  -- @'Internal.componentCmmGhcOptions'@)
  -> Bool
  -- ^ Some types of build sources should not be built in the dynamic way, namely, JS sources.
  -- I'm not entirely sure this remains true after we migrate to supporting GHC's JS backend rather than GHCJS.
  -- Boolean for "do we allow building these sources the dynamic way?"
  -> (Component -> [SymbolicPath Pkg File])
  -- ^ View the extra sources of a component, typically from
  -- the build info (e.g. @'asmSources'@, @'cSources'@).
  -- @'Executable'@ components might additionally add the
  -- program entry point (@main-is@ file) to the extra sources,
  -- if it should be compiled as the rest of them.
  -> ConfiguredProgram
  -- ^ The GHC configured program
  -> SymbolicPath Pkg (Dir Artifacts)
  -- ^ The build directory for this target
  -> PreBuildComponentInputs
  -- ^ The context and component being built in it.
  -> IO (NubListR (SymbolicPath Pkg File))
  -- ^ Returns the list of extra sources that were built
buildExtraSources :: String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> Bool
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources String
description Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
componentSourceGhcOptions Bool
wantDyn Component -> [SymbolicPath Pkg 'File]
viewSources ConfiguredProgram
ghcProg SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir =
  \PreBuildComponentInputs{BuildingWhat
buildingWhat :: BuildingWhat
buildingWhat :: PreBuildComponentInputs -> BuildingWhat
buildingWhat, localBuildInfo :: PreBuildComponentInputs -> LocalBuildInfo
localBuildInfo = LocalBuildInfo
lbi, TargetInfo
targetInfo :: TargetInfo
targetInfo :: PreBuildComponentInputs -> TargetInfo
targetInfo} -> do
    let
      bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo (TargetInfo -> Component
targetComponent TargetInfo
targetInfo)
      verbosity :: Verbosity
verbosity = BuildingWhat -> Verbosity
buildingWhatVerbosity BuildingWhat
buildingWhat
      clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
targetInfo
      mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
      i :: SymbolicPathX allowAbsolute Pkg to -> String
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
      sources :: [SymbolicPath Pkg 'File]
sources = Component -> [SymbolicPath Pkg 'File]
viewSources (TargetInfo -> Component
targetComponent TargetInfo
targetInfo)
      comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      -- Instead of keeping this logic here, we really just want to
      -- receive as an input the `neededWays` from GHC/Build.build and build
      -- accordingly, since we've already determined the extra needed ways
      -- needed for e.g. template haskell. Although we'd have to account for 'wantDyn'.
      isGhcDynamic :: Bool
isGhcDynamic = Compiler -> Bool
isDynamic Compiler
comp
      doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
bi
      forceSharedLib :: Bool
forceSharedLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool
isGhcDynamic
      runGhcProg :: Maybe (SymbolicPath CWD ('Dir Pkg)) -> GhcOptions -> IO ()
runGhcProg = Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> GhcOptions
-> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcProg Compiler
comp Platform
platform

      buildAction :: SymbolicPath Pkg File -> IO ()
      buildAction :: SymbolicPath Pkg 'File -> IO ()
buildAction SymbolicPath Pkg 'File
sourceFile = do
        let baseSrcOpts :: GhcOptions
baseSrcOpts =
              Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
componentSourceGhcOptions
                Verbosity
verbosity
                LocalBuildInfo
lbi
                BuildInfo
bi
                ComponentLocalBuildInfo
clbi
                SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
                SymbolicPath Pkg 'File
sourceFile
            vanillaSrcOpts :: GhcOptions
vanillaSrcOpts
              -- Dynamic GHC requires C sources to be built
              -- with -fPIC for REPL to work. See #2207.
              | Bool
isGhcDynamic Bool -> Bool -> Bool
&& Bool
wantDyn = GhcOptions
baseSrcOpts{ghcOptFPic = toFlag True}
              | Bool
otherwise = GhcOptions
baseSrcOpts
            profSrcOpts :: GhcOptions
profSrcOpts =
              GhcOptions
vanillaSrcOpts
                GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
                  { ghcOptProfilingMode = toFlag True
                  }
            sharedSrcOpts :: GhcOptions
sharedSrcOpts =
              GhcOptions
vanillaSrcOpts
                GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
                  { ghcOptFPic = toFlag True
                  , ghcOptDynLinkMode = toFlag GhcDynamicOnly
                  }
            -- TODO: Placing all Haskell, C, & C++ objects in a single directory
            --       Has the potential for file collisions. In general we would
            --       consider this a user error. However, we should strive to
            --       add a warning if this occurs.
            odir :: SymbolicPath Pkg ('Dir Artifacts)
odir = Flag (SymbolicPath Pkg ('Dir Artifacts))
-> SymbolicPath Pkg ('Dir Artifacts)
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag (SymbolicPath Pkg ('Dir Artifacts))
ghcOptObjDir GhcOptions
vanillaSrcOpts)

            compileIfNeeded :: GhcOptions -> IO ()
            compileIfNeeded :: GhcOptions -> IO ()
compileIfNeeded GhcOptions
opts = do
              Bool
needsRecomp <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> GhcOptions -> IO Bool
checkNeedsRecompilation Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
sourceFile GhcOptions
opts
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (SymbolicPath CWD ('Dir Pkg)) -> GhcOptions -> IO ()
runGhcProg Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir GhcOptions
opts

        -- TODO: This whole section can be streamlined to the
        -- wantedWays+neededWays logic used in Build/Modules.hs
        Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True (SymbolicPath Pkg ('Dir Artifacts) -> String
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> String
i SymbolicPath Pkg ('Dir Artifacts)
odir)
        case TargetInfo -> Component
targetComponent TargetInfo
targetInfo of
          -- For libraries, we compile extra objects in the three ways: vanilla, shared, and profiled.
          -- We suffix shared objects with .dyn_o and profiled ones with .p_o.
          CLib Library
_lib
            -- Unless for repl, in which case we only need the vanilla way
            | BuildRepl ReplFlags
_ <- BuildingWhat
buildingWhat ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
            | Bool
otherwise ->
                do
                  GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
wantDyn Bool -> Bool -> Bool
&& (Bool
forceSharedLib Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts{ghcOptObjSuffix = toFlag "dyn_o"}
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts{ghcOptObjSuffix = toFlag "p_o"}

          -- For foreign libraries, we determine with which options to build the
          -- objects (vanilla vs shared vs profiled)
          CFLib ForeignLib
flib
            | LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi -> -- It doesn't sound right to query "ProfExe" for a foreign library...
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts
            | ForeignLib -> Bool
withDynFLib ForeignLib
flib Bool -> Bool -> Bool
&& Bool
wantDyn ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts
            | Bool
otherwise ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
          -- For the remaining component types (Exec, Test, Bench), we also
          -- determine with which options to build the objects (vanilla vs shared vs
          -- profiled), but predicate is the same for the three kinds.
          Component
_exeLike
            | LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts
            | LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
wantDyn ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts
            | Bool
otherwise ->
                GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
    -- build any sources
    if ([SymbolicPath Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicPath Pkg 'File]
sources Bool -> Bool -> Bool
|| ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
      then NubListR (SymbolicPath Pkg 'File)
-> IO (NubListR (SymbolicPath Pkg 'File))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR (SymbolicPath Pkg 'File)
forall a. Monoid a => a
mempty
      else do
        Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"Building " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
description String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
        (SymbolicPath Pkg 'File -> IO ())
-> [SymbolicPath Pkg 'File] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ SymbolicPath Pkg 'File -> IO ()
buildAction [SymbolicPath Pkg 'File]
sources
        NubListR (SymbolicPath Pkg 'File)
-> IO (NubListR (SymbolicPath Pkg 'File))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolicPath Pkg 'File] -> NubListR (SymbolicPath Pkg 'File)
forall a. Ord a => [a] -> NubListR a
toNubListR [SymbolicPath Pkg 'File]
sources)