{-# 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.Modules
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.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
  :: Maybe (SymbolicPath Pkg File)
  -- ^ An optional non-Haskell Main file
  -> ConfiguredProgram
  -- ^ The GHC configured program
  -> SymbolicPath Pkg (Dir Artifacts)
  -- ^ The build directory for this target
  -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
  -- ^ Needed build ways
  -> 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 :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAllExtraSources =
  [Maybe (SymbolicPath Pkg 'File)
 -> ConfiguredProgram
 -> SymbolicPath Pkg ('Dir Artifacts)
 -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
 -> PreBuildComponentInputs
 -> IO (NubListR (SymbolicPath Pkg 'File))]
-> Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
forall a. Monoid a => [a] -> a
mconcat
    [ Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCSources
    , Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCxxSources
    , Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildJsSources
    , Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAsmSources
    , Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCmmSources
    ]

buildCSources
  , buildCxxSources
  , buildJsSources
  , buildAsmSources
  , buildCmmSources
    :: Maybe (SymbolicPath Pkg File)
    -- ^ An optional non-Haskell Main file
    -> ConfiguredProgram
    -- ^ The GHC configured program
    -> SymbolicPath Pkg (Dir Artifacts)
    -- ^ The build directory for this target
    -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
    -- ^ Needed build ways
    -> PreBuildComponentInputs
    -- ^ The context and component being built in it.
    -> IO (NubListR (SymbolicPath Pkg File))
    -- ^ Returns the list of extra sources that were built
buildCSources :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCSources Maybe (SymbolicPath Pkg 'File)
mbMainFile =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCcGhcOptions
    ( \Component
c -> do
        let cFiles :: [SymbolicPath Pkg 'File]
cFiles = BuildInfo -> [SymbolicPath Pkg 'File]
cSources (Component -> BuildInfo
componentBuildInfo Component
c)
        case Component
c of
          CExe{}
            | Just SymbolicPath Pkg 'File
main <- Maybe (SymbolicPath Pkg 'File)
mbMainFile
            , String -> Bool
isC (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg 'File -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath Pkg 'File
main ->
                [SymbolicPath Pkg 'File]
cFiles [SymbolicPath Pkg 'File]
-> [SymbolicPath Pkg 'File] -> [SymbolicPath Pkg 'File]
forall a. [a] -> [a] -> [a]
++ [SymbolicPath Pkg 'File
main]
          Component
_otherwise -> [SymbolicPath Pkg 'File]
cFiles
    )
buildCxxSources :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCxxSources Maybe (SymbolicPath Pkg 'File)
mbMainFile =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C++ Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCxxGhcOptions
    ( \Component
c -> do
        let cxxFiles :: [SymbolicPath Pkg 'File]
cxxFiles = BuildInfo -> [SymbolicPath Pkg 'File]
cxxSources (Component -> BuildInfo
componentBuildInfo Component
c)
        case Component
c of
          CExe{}
            | Just SymbolicPath Pkg 'File
main <- Maybe (SymbolicPath Pkg 'File)
mbMainFile
            , String -> Bool
isCxx (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg 'File -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath Pkg 'File
main ->
                [SymbolicPath Pkg 'File]
cxxFiles [SymbolicPath Pkg 'File]
-> [SymbolicPath Pkg 'File] -> [SymbolicPath Pkg 'File]
forall a. [a] -> [a] -> [a]
++ [SymbolicPath Pkg 'File
main]
          Component
_otherwise -> [SymbolicPath Pkg 'File]
cxxFiles
    )
buildJsSources :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildJsSources Maybe (SymbolicPath Pkg 'File)
_mbMainFile ConfiguredProgram
ghcProg SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
neededWays = 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)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"JS Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentJsGhcOptions
    ( \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
    (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
neededWays
buildAsmSources :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildAsmSources Maybe (SymbolicPath Pkg 'File)
_mbMainFile =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"Assembler Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentAsmGhcOptions
    (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 :: Maybe (SymbolicPath Pkg 'File)
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildCmmSources Maybe (SymbolicPath Pkg 'File)
_mbMainFile =
  String
-> (Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> SymbolicPath Pkg 'File
    -> GhcOptions)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
    String
"C-- Sources"
    Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
Internal.componentCmmGhcOptions
    (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'@)
  -> (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
  -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
  -- ^ Needed build ways
  -> 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)
-> (Component -> [SymbolicPath Pkg 'File])
-> ConfiguredProgram
-> SymbolicPath Pkg ('Dir Artifacts)
-> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)
-> PreBuildComponentInputs
-> IO (NubListR (SymbolicPath Pkg 'File))
buildExtraSources
  String
description
  Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath Pkg ('Dir Artifacts)
-> SymbolicPath Pkg 'File
-> GhcOptions
componentSourceGhcOptions
  Component -> [SymbolicPath Pkg 'File]
viewSources
  ConfiguredProgram
ghcProg
  SymbolicPath Pkg ('Dir Artifacts)
buildTargetDir
  (Bool -> [BuildWay]
neededLibWays, Bool -> BuildWay
neededFLibWay, BuildWay
neededExeWay) =
    \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
        isIndef :: Bool
isIndef = ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi
        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 from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from 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
        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 =
                -- -fPIC is used in case you are using the repl
                -- of a dynamically linked GHC
                GhcOptions
baseSrcOpts{ghcOptFPic = toFlag True}
              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
                    }
              profSharedSrcOpts :: GhcOptions
profSharedSrcOpts =
                GhcOptions
vanillaSrcOpts
                  GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
                    { ghcOptProfilingMode = toFlag True
                    , 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

          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 four ways: vanilla, shared, profiled and profiled shared.
            -- We suffix shared objects with `.dyn_o`, profiled ones with `.p_o` and profiled shared ones with `.p_dyn_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
                    [BuildWay] -> (BuildWay -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Bool -> [BuildWay]
neededLibWays Bool
isIndef) ((BuildWay -> IO ()) -> IO ()) -> (BuildWay -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
                      BuildWay
StaticWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
                      BuildWay
DynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts{ghcOptObjSuffix = toFlag "dyn_o"}
                      BuildWay
ProfWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts{ghcOptObjSuffix = toFlag "p_o"}
                      BuildWay
ProfDynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSharedSrcOpts{ghcOptObjSuffix = toFlag "p_dyn_o"}
            CFLib ForeignLib
flib ->
              case Bool -> BuildWay
neededFLibWay (ForeignLib -> Bool
withDynFLib ForeignLib
flib) of
                BuildWay
StaticWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
                BuildWay
DynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts
                BuildWay
ProfWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts
                BuildWay
ProfDynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSharedSrcOpts
            -- 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 ->
              case BuildWay
neededExeWay of
                BuildWay
StaticWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
vanillaSrcOpts
                BuildWay
DynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
sharedSrcOpts
                BuildWay
ProfWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSrcOpts
                BuildWay
ProfDynWay -> GhcOptions -> IO ()
compileIfNeeded GhcOptions
profSharedSrcOpts
      -- 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)