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

    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.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.Verbosity (Verbosity)

    import Distribution.Simple.Build.Inputs

    -- | 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
      -> FilePath
      -- ^ The build directory for this target
      -> PreBuildComponentInputs
      -- ^ The context and component being built in it.
      -> IO (NubListR FilePath)
      -- ^ Returns the (nubbed) list of extra sources that were built
    buildAllExtraSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildAllExtraSources =
      [ConfiguredProgram
     -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)]
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    forall a. Monoid a => [a] -> a
    mconcat
        [ ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCSources
        , ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCxxSources
        , ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildJsSources
        , ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildAsmSources
        , ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCmmSources
        ]

    buildCSources
      , buildCxxSources
      , buildJsSources
      , buildAsmSources
      , buildCmmSources
        :: ConfiguredProgram
        -- ^ The GHC configured program
        -> FilePath
        -- ^ The build directory for this target
        -> PreBuildComponentInputs
        -- ^ The context and component being built in it.
        -> IO (NubListR FilePath)
        -- ^ Returns the list of extra sources that were built
    buildCSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCSources =
      FilePath
    -> (Verbosity
        -> LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> FilePath
        -> GhcOptions)
    -> Bool
    -> (Component -> [FilePath])
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    buildExtraSources
        FilePath
    "C Sources"
        Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    Internal.componentCcGhcOptions
        Bool
    True
        ( \Component
    c ->
            BuildInfo -> [FilePath]
    cSources (Component -> BuildInfo
    componentBuildInfo Component
    c)
              [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ case Component
    c of
                CExe Executable
    exe | FilePath -> Bool
    isC (Executable -> FilePath
    modulePath Executable
    exe) -> [Executable -> FilePath
    modulePath Executable
    exe]
                Component
    _otherwise -> []
        )
    buildCxxSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCxxSources =
      FilePath
    -> (Verbosity
        -> LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> FilePath
        -> GhcOptions)
    -> Bool
    -> (Component -> [FilePath])
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    buildExtraSources
        FilePath
    "C++ Sources"
        Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    Internal.componentCxxGhcOptions
        Bool
    True
        ( \Component
    c ->
            BuildInfo -> [FilePath]
    cxxSources (Component -> BuildInfo
    componentBuildInfo Component
    c)
              [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ case Component
    c of
                CExe Executable
    exe | FilePath -> Bool
    isCxx (Executable -> FilePath
    modulePath Executable
    exe) -> [Executable -> FilePath
    modulePath Executable
    exe]
                Component
    _otherwise -> []
        )
    buildJsSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildJsSources ConfiguredProgram
    ghcProg FilePath
    buildTargetDir = do
      Platform hostArch _ <- 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 = Arch
    hostArch Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    JavaScript
      buildExtraSources
        "JS Sources"
        Internal.componentJsGhcOptions
        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 -> [FilePath]
    jsSources (Component -> BuildInfo
    componentBuildInfo Component
    c)
              else [FilePath]
    forall a. Monoid a => a
    mempty
        )
        ghcProg
        buildTargetDir
    buildAsmSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildAsmSources =
      FilePath
    -> (Verbosity
        -> LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> FilePath
        -> GhcOptions)
    -> Bool
    -> (Component -> [FilePath])
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    buildExtraSources
        FilePath
    "Assembler Sources"
        Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    Internal.componentAsmGhcOptions
        Bool
    True
        (BuildInfo -> [FilePath]
    asmSources (BuildInfo -> [FilePath])
    -> (Component -> BuildInfo) -> Component -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Component -> BuildInfo
    componentBuildInfo)
    buildCmmSources :: ConfiguredProgram
    -> FilePath -> PreBuildComponentInputs -> IO (NubListR FilePath)
    buildCmmSources =
      FilePath
    -> (Verbosity
        -> LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> FilePath
        -> GhcOptions)
    -> Bool
    -> (Component -> [FilePath])
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    buildExtraSources
        FilePath
    "C-- Sources"
        Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    Internal.componentCmmGhcOptions
        Bool
    True
        (BuildInfo -> [FilePath]
    cmmSources (BuildInfo -> [FilePath])
    -> (Component -> BuildInfo) -> Component -> [FilePath]
    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 -> FilePath -> FilePath -> 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 -> [FilePath])
      -- ^ 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
      -> FilePath
      -- ^ The build directory for this target
      -> PreBuildComponentInputs
      -- ^ The context and component being built in it.
      -> IO (NubListR FilePath)
      -- ^ Returns the list of extra sources that were built
    buildExtraSources :: FilePath
    -> (Verbosity
        -> LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> FilePath
        -> GhcOptions)
    -> Bool
    -> (Component -> [FilePath])
    -> ConfiguredProgram
    -> FilePath
    -> PreBuildComponentInputs
    -> IO (NubListR FilePath)
    buildExtraSources FilePath
    description Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    componentSourceGhcOptions Bool
    wantDyn Component -> [FilePath]
    viewSources ConfiguredProgram
    ghcProg FilePath
    buildTargetDir =
      \PreBuildComponentInputs{BuildingWhat
    buildingWhat :: BuildingWhat
    buildingWhat :: PreBuildComponentInputs -> BuildingWhat
    buildingWhat, localBuildInfo :: PreBuildComponentInputs -> LocalBuildInfo
    localBuildInfo = LocalBuildInfo
    lbi, TargetInfo
    targetInfo :: TargetInfo
    targetInfo :: PreBuildComponentInputs -> TargetInfo
    targetInfo} ->
        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

          sources :: [FilePath]
    sources = Component -> [FilePath]
    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 :: GhcOptions -> IO ()
    runGhcProg = Verbosity
    -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
    runGHC Verbosity
    verbosity ConfiguredProgram
    ghcProg Compiler
    comp Platform
    platform

          buildAction :: FilePath -> IO ()
    buildAction FilePath
    sourceFile = do
            let baseSrcOpts :: GhcOptions
    baseSrcOpts =
                  Verbosity
    -> LocalBuildInfo
    -> BuildInfo
    -> ComponentLocalBuildInfo
    -> FilePath
    -> FilePath
    -> GhcOptions
    componentSourceGhcOptions
                    Verbosity
    verbosity
                    LocalBuildInfo
    lbi
                    BuildInfo
    bi
                    ComponentLocalBuildInfo
    clbi
                    FilePath
    buildTargetDir
                    FilePath
    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 :: FilePath
    odir = Flag FilePath -> FilePath
    forall a. WithCallStack (Flag a -> a)
    fromFlag (GhcOptions -> Flag FilePath
    ghcOptObjDir GhcOptions
    vanillaSrcOpts)
                compileIfNeeded :: GhcOptions -> IO ()
    compileIfNeeded GhcOptions
    opts = do
                  needsRecomp <- FilePath -> GhcOptions -> IO Bool
    checkNeedsRecompilation FilePath
    sourceFile GhcOptions
    opts
                  when needsRecomp $ runGhcProg opts

            -- TODO: This whole section can be streamlined to the
            -- wantedWays+neededWays logic used in Build/Modules.hs
            Verbosity -> Bool -> FilePath -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True FilePath
    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
         in
          -- build any sources
          if ([FilePath] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    sources Bool -> Bool -> Bool
    || ComponentLocalBuildInfo -> Bool
    componentIsIndefinite ComponentLocalBuildInfo
    clbi)
            then NubListR FilePath -> IO (NubListR FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NubListR FilePath
    forall a. Monoid a => a
    mempty
            else do
              Verbosity -> FilePath -> IO ()
    info Verbosity
    verbosity (FilePath
    "Building " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    description FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "...")
              (FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ FilePath -> IO ()
    buildAction [FilePath]
    sources
              NubListR FilePath -> IO (NubListR FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([FilePath] -> NubListR FilePath
    forall a. Ord a => [a] -> NubListR a
    toNubListR [FilePath]
    sources)