{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

module Distribution.Simple.GHCJS (
        configure, getInstalledPackages, getPackageDBContents,
        buildLib, buildExe,
        replLib, replExe,
        startInterpreter,
        installLib, installExe,
        libAbiHash,
        hcPkgInfo,
        registerPackage,
        componentGhcOptions,
        getLibDir,
        isDynamic,
        getGlobalPackageDB,
        runCmd
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.UnqualComponentName
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo
import Distribution.Simple.PackageIndex ( InstalledPackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar    as Ar
import qualified Distribution.Simple.Program.Ld    as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup hiding ( Flag )
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler hiding ( Flag )
import Distribution.Version
import Distribution.System
import Distribution.Verbosity
import Distribution.Utils.NubList
import Distribution.Pretty
import Distribution.Types.UnitId

import qualified Data.Map as Map
import System.Directory         ( doesFileExist )
import System.FilePath          ( (</>), (<.>), takeExtension
                                , takeDirectory, replaceExtension )

configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
          -> ProgramDb
          -> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity :: Verbosity
verbosity hcPath :: Maybe FilePath
hcPath hcPkgPath :: Maybe FilePath
hcPkgPath progdb0 :: ProgramDb
progdb0 = do
  (ghcjsProg :: ConfiguredProgram
ghcjsProg, ghcjsVersion :: Version
ghcjsVersion, progdb1 :: ProgramDb
progdb1) <-
    Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcjsProgram
      (Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [0,1]))
      (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath "ghcjs" Maybe FilePath
hcPath ProgramDb
progdb0)
  Just ghcjsGhcVersion :: Version
ghcjsGhcVersion <- Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg)
  let implInfo :: GhcImplInfo
implInfo = Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo Version
ghcjsVersion Version
ghcjsGhcVersion

  -- This is slightly tricky, we have to configure ghcjs first, then we use the
  -- location of ghcjs to help find ghcjs-pkg in the case that the user did not
  -- specify the location of ghc-pkg directly:
  (ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg, ghcjsPkgVersion :: Version
ghcjsPkgVersion, progdb2 :: ProgramDb
progdb2) <-
    Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcjsPkgProgram {
      programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath ConfiguredProgram
ghcjsProg
    }
    VersionRange
anyVersion (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath "ghcjs-pkg" Maybe FilePath
hcPkgPath ProgramDb
progdb1)

  Just ghcjsPkgGhcjsVersion :: Version
ghcjsPkgGhcjsVersion <- Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion
                                  Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgGhcjsVersion) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
       "Version mismatch between ghcjs and ghcjs-pkg: "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsPkgGhcjsVersion

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsGhcVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgVersion) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
       "Version mismatch between ghcjs and ghcjs-pkg: "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " was built with GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsGhcVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " "
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg
    FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " was built with GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsPkgVersion

  -- be sure to use our versions of hsc2hs, c2hs, haddock and ghc
  let hsc2hsProgram' :: Program
hsc2hsProgram' =
        Program
hsc2hsProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
                          ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath ConfiguredProgram
ghcjsProg }
      c2hsProgram' :: Program
c2hsProgram' =
        Program
c2hsProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
                          ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath ConfiguredProgram
ghcjsProg }

      haddockProgram' :: Program
haddockProgram' =
        Program
haddockProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
                          ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath ConfiguredProgram
ghcjsProg }
      progdb3 :: ProgramDb
progdb3 = [Program] -> ProgramDb -> ProgramDb
addKnownPrograms [ Program
hsc2hsProgram', Program
c2hsProgram', Program
haddockProgram' ] ProgramDb
progdb2

  [(Language, FilePath)]
languages  <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> NoCallStackIO [(Language, FilePath)]
Internal.getLanguages  Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
  [(Extension, Maybe FilePath)]
extensions <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> IO [(Extension, Maybe FilePath)]
Internal.getExtensions Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg

  [(FilePath, FilePath)]
ghcInfo <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(FilePath, FilePath)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
  let ghcInfoMap :: Map FilePath FilePath
ghcInfoMap = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath, FilePath)]
ghcInfo

  let comp :: Compiler
comp = Compiler :: CompilerId
-> AbiTag
-> [CompilerId]
-> [(Language, FilePath)]
-> [(Extension, Maybe FilePath)]
-> Map FilePath FilePath
-> Compiler
Compiler {
        compilerId :: CompilerId
compilerId         = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHCJS Version
ghcjsVersion,
        compilerAbiTag :: AbiTag
compilerAbiTag     = FilePath -> AbiTag
AbiTag (FilePath -> AbiTag) -> FilePath -> AbiTag
forall a b. (a -> b) -> a -> b
$
          "ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "_" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show ([Int] -> [FilePath])
-> (Version -> [Int]) -> Version -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers (Version -> [FilePath]) -> Version -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Version
ghcjsGhcVersion),
        compilerCompat :: [CompilerId]
compilerCompat     = [CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHC Version
ghcjsGhcVersion],
        compilerLanguages :: [(Language, FilePath)]
compilerLanguages  = [(Language, FilePath)]
languages,
        compilerExtensions :: [(Extension, Maybe FilePath)]
compilerExtensions = [(Extension, Maybe FilePath)]
extensions,
        compilerProperties :: Map FilePath FilePath
compilerProperties = Map FilePath FilePath
ghcInfoMap
      }
      compPlatform :: Maybe Platform
compPlatform = [(FilePath, FilePath)] -> Maybe Platform
Internal.targetPlatform [(FilePath, FilePath)]
ghcInfo
  -- configure gcc and ld
  let progdb4 :: ProgramDb
progdb4 = if Compiler -> Bool
ghcjsNativeToo Compiler
comp
                     then GhcImplInfo
-> ConfiguredProgram
-> Map FilePath FilePath
-> ProgramDb
-> ProgramDb
Internal.configureToolchain GhcImplInfo
implInfo
                            ConfiguredProgram
ghcjsProg Map FilePath FilePath
ghcInfoMap ProgramDb
progdb3
                     else ProgramDb
progdb3
  (Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
compPlatform, ProgramDb
progdb4)

ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "Native Too"

guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity
                           -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
ghcjsPkgProgram

guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
                         -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
hsc2hsProgram

guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
                       -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
c2hsProgram

guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
                          -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
haddockProgram

guessToolFromGhcjsPath :: Program -> ConfiguredProgram
                       -> Verbosity -> ProgramSearchPath
                       -> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath :: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath tool :: Program
tool ghcjsProg :: ConfiguredProgram
ghcjsProg verbosity :: Verbosity
verbosity searchpath :: ProgramSearchPath
searchpath
  = do let toolname :: FilePath
toolname          = Program -> FilePath
programName Program
tool
           path :: FilePath
path              = ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
           dir :: FilePath
dir               = FilePath -> FilePath
takeDirectory FilePath
path
           versionSuffix :: FilePath
versionSuffix     = FilePath -> FilePath
takeVersionSuffix (FilePath -> FilePath
dropExeExtension FilePath
path)
           guessNormal :: FilePath
guessNormal       = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
toolname FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guessGhcjsVersioned :: FilePath
guessGhcjsVersioned = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-ghcjs" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
versionSuffix)
                                 FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guessGhcjs :: FilePath
guessGhcjs        = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-ghcjs")
                               FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guessVersioned :: FilePath
guessVersioned    = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
versionSuffix) FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
           guesses :: [FilePath]
guesses | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
versionSuffix = [FilePath
guessGhcjs, FilePath
guessNormal]
                   | Bool
otherwise          = [FilePath
guessGhcjsVersioned,
                                           FilePath
guessGhcjs,
                                           FilePath
guessVersioned,
                                           FilePath
guessNormal]
       Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "looking for tool " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname
         FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " near compiler in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
       [Bool]
exists <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Bool
doesFileExist [FilePath]
guesses
       case [ FilePath
file | (file :: FilePath
file, True) <- [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists ] of
                   -- If we can't find it near ghc, fall back to the usual
                   -- method.
         []     -> Program
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
programFindLocation Program
tool Verbosity
verbosity ProgramSearchPath
searchpath
         (fp :: FilePath
fp:_) -> do Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
                      let lookedAt :: [FilePath]
lookedAt = ((FilePath, Bool) -> FilePath) -> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst
                                   ([(FilePath, Bool)] -> [FilePath])
-> ([(FilePath, Bool)] -> [(FilePath, Bool)])
-> [(FilePath, Bool)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Bool) -> Bool)
-> [(FilePath, Bool)] -> [(FilePath, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(_file :: FilePath
_file, exist :: Bool
exist) -> Bool -> Bool
not Bool
exist)
                                   ([(FilePath, Bool)] -> [FilePath])
-> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists
                      Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, [FilePath]) -> Maybe (FilePath, [FilePath])
forall a. a -> Maybe a
Just (FilePath
fp, [FilePath]
lookedAt))

  where takeVersionSuffix :: FilePath -> String
        takeVersionSuffix :: FilePath -> FilePath
takeVersionSuffix = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (`elem ` "0123456789.-") (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            FilePath -> FilePath
forall a. [a] -> [a]
reverse

-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
                     -> IO InstalledPackageIndex
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents verbosity :: Verbosity
verbosity packagedb :: PackageDB
packagedb progdb :: ProgramDb
progdb = do
  [(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB
packagedb] ProgramDb
progdb
  Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb

-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
                     -> IO InstalledPackageIndex
getInstalledPackages :: Verbosity -> [PackageDB] -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackages verbosity :: Verbosity
verbosity packagedbs :: [PackageDB]
packagedbs progdb :: ProgramDb
progdb = do
  Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity
  Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
packagedbs
  [(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb
  InstalledPackageIndex
index <- Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb
  InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! InstalledPackageIndex
index

toPackageIndex :: Verbosity
               -> [(PackageDB, [InstalledPackageInfo])]
               -> ProgramDb
               -> IO InstalledPackageIndex
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex verbosity :: Verbosity
verbosity pkgss :: [(PackageDB, [InstalledPackageInfo])]
pkgss progdb :: ProgramDb
progdb = do
  -- On Windows, various fields have $topdir/foo rather than full
  -- paths. We need to substitute the right value in so that when
  -- we, for example, call gcc, we have proper paths to give it.
  FilePath
topDir <- Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg
  let indices :: [InstalledPackageIndex]
indices = [ [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList ((InstalledPackageInfo -> InstalledPackageInfo)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> InstalledPackageInfo -> InstalledPackageInfo
Internal.substTopDir FilePath
topDir) [InstalledPackageInfo]
pkgs)
                | (_, pkgs :: [InstalledPackageInfo]
pkgs) <- [(PackageDB, [InstalledPackageInfo])]
pkgss ]
  InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! ([InstalledPackageIndex] -> InstalledPackageIndex
forall a. Monoid a => [a] -> a
mconcat [InstalledPackageIndex]
indices)

  where
    Just ghcjsProg :: ConfiguredProgram
ghcjsProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb

checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar verbosity :: Verbosity
verbosity =
    Verbosity -> FilePath -> FilePath -> IO ()
Internal.checkPackageDbEnvVar Verbosity
verbosity "GHCJS" "GHCJS_PACKAGE_PATH"

checkPackageDbStack :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStack :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack _ (GlobalPackageDB:rest :: [PackageDB]
rest)
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStack verbosity :: Verbosity
verbosity rest :: [PackageDB]
rest
  | PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest =
  Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "With current ghc versions the global package db is always used "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "and must be listed first. This ghc limitation may be lifted in "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "future, see http://ghc.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStack verbosity :: Verbosity
verbosity _ =
  Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "If the global package db is specified, it must be "
     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "specified first and cannot be specified multiple times"

getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
                      -> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' :: Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity :: Verbosity
verbosity packagedbs :: [PackageDB]
packagedbs progdb :: ProgramDb
progdb =
  [IO (PackageDB, [InstalledPackageInfo])]
-> IO [(PackageDB, [InstalledPackageInfo])]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
    [ do [InstalledPackageInfo]
pkgs <- HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
HcPkg.dump (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity PackageDB
packagedb
         (PackageDB, [InstalledPackageInfo])
-> IO (PackageDB, [InstalledPackageInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDB
packagedb, [InstalledPackageInfo]
pkgs)
    | PackageDB
packagedb <- [PackageDB]
packagedbs ]

getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi =
    (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity Program
ghcjsProgram
     (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) ["--print-libdir"]

getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity :: Verbosity
verbosity ghcjsProg :: ConfiguredProgram
ghcjsProg =
    (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcjsProg ["--print-libdir"]

-- | Return the 'FilePath' to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity :: Verbosity
verbosity ghcjsProg :: ConfiguredProgram
ghcjsProg =
    (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
     Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcjsProg ["--print-global-package-db"]

toJSLibName :: String -> String
toJSLibName :: FilePath -> FilePath
toJSLibName lib :: FilePath
lib
  | FilePath -> FilePath
takeExtension FilePath
lib FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [".dll",".dylib",".so"]
                              = FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib "js_so"
  | FilePath -> FilePath
takeExtension FilePath
lib FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".a" = FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib "js_a"
  | Bool
otherwise                 = FilePath
lib FilePath -> FilePath -> FilePath
<.> "js_a"

buildLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription
         -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
         -> IO ()
buildLib :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe [FilePath]
forall a. Maybe a
Nothing

replLib :: [String]                -> Verbosity
        -> Cabal.Flag (Maybe Int)  -> PackageDescription
        -> LocalBuildInfo          -> Library
        -> ComponentLocalBuildInfo -> IO ()
replLib :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib (Maybe [FilePath]
 -> Verbosity
 -> Flag (Maybe Int)
 -> PackageDescription
 -> LocalBuildInfo
 -> Library
 -> ComponentLocalBuildInfo
 -> IO ())
-> ([FilePath] -> Maybe [FilePath])
-> [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just

buildOrReplLib :: Maybe [String] -> Verbosity
               -> Cabal.Flag (Maybe Int)  -> PackageDescription
               -> LocalBuildInfo          -> Library
               -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib :: Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib mReplFlags :: Maybe [FilePath]
mReplFlags verbosity :: Verbosity
verbosity numJobs :: Flag (Maybe Int)
numJobs pkg_descr :: PackageDescription
pkg_descr lbi :: LocalBuildInfo
lbi lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
  let uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
      libTargetDir :: FilePath
libTargetDir = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi
      whenVanillaLib :: Bool -> f () -> f ()
whenVanillaLib forceVanilla :: Bool
forceVanilla =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& (Bool
forceVanilla Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi))
      whenProfLib :: IO () -> IO ()
whenProfLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
      whenSharedLib :: Bool -> f () -> f ()
whenSharedLib forceShared :: Bool
forceShared =
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&&  (Bool
forceShared Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi))
      whenGHCiLib :: IO () -> IO ()
whenGHCiLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi)
      forRepl :: Bool
forRepl = Bool -> ([FilePath] -> Bool) -> Maybe [FilePath] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> [FilePath] -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe [FilePath]
mReplFlags
      ifReplLib :: IO () -> IO ()
ifReplLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forRepl
      replFlags :: [FilePath]
replFlags = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [FilePath]
forall a. Monoid a => a
mempty Maybe [FilePath]
mReplFlags
      comp :: Compiler
comp      = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform  = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      implInfo :: GhcImplInfo
implInfo  = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
      nativeToo :: Bool
nativeToo = Compiler -> Bool
ghcjsNativeToo Compiler
comp

  (ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let runGhcjsProg :: GhcOptions -> IO ()
runGhcjsProg        = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
      libBi :: BuildInfo
libBi               = Library -> BuildInfo
libBuildInfo Library
lib
      isGhcjsDynamic :: Bool
isGhcjsDynamic      = Compiler -> Bool
isDynamic Compiler
comp
      dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
      doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
libBi
      forceVanillaLib :: Bool
forceVanillaLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isGhcjsDynamic
      forceSharedLib :: Bool
forceSharedLib  = Bool
doingTH Bool -> Bool -> Bool
&&     Bool
isGhcjsDynamic
      -- TH always needs default libs, even when building for profiling

  -- Determine if program coverage should be enabled and if so, what
  -- '-hpcdir' should be.
  let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi
      pkg_name :: FilePath
pkg_name = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> FilePath) -> PackageIdentifier -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr
      distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
      hpcdir :: Way -> Flag FilePath
hpcdir way :: Way
way
        | Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way FilePath
pkg_name
        | Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty

  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
libTargetDir
  -- TODO: do we need to put hs-boot files into place for mutually recursive
  -- modules?
  let cObjs :: [FilePath]
cObjs       = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) (BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
      jsSrcs :: [FilePath]
jsSrcs      = BuildInfo -> [FilePath]
jsSources BuildInfo
libBi
      baseOpts :: GhcOptions
baseOpts    = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
libTargetDir
      linkJsLibOpts :: GhcOptions
linkJsLibOpts = GhcOptions
forall a. Monoid a => a
mempty {
                        ghcOptExtra :: [FilePath]
ghcOptExtra =
                          [ "-link-js-lib"     , UnitId -> FilePath
getHSLibraryName UnitId
uid
                          , "-js-lib-outputdir", FilePath
libTargetDir ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                          [FilePath]
jsSrcs
                      }
      vanillaOptsNoJsLib :: GhcOptions
vanillaOptsNoJsLib = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
                      ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs      = Flag (Maybe Int)
numJobs,
                      ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir       = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
                    }
      vanillaOpts :: GhcOptions
vanillaOpts = GhcOptions
vanillaOptsNoJsLib GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkJsLibOpts

      profOpts :: GhcOptions
profOpts    = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "p_hi" "p_o" GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                        ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                        ghcOptExtra :: [FilePath]
ghcOptExtra         = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
libBi,
                        ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir        = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
                      }
      sharedOpts :: GhcOptions
sharedOpts  = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                        ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                        ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                        ghcOptExtra :: [FilePath]
ghcOptExtra       = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi,
                        ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir      = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                      }
      linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions    = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
libBi,
                      ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs       = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
                      ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath    = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi,
                      ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
libBi,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles     =
                        [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cObjs] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
jsSrcs
                   }
      replOpts :: GhcOptions
replOpts    = GhcOptions
vanillaOptsNoJsLib {
                      ghcOptExtra :: [FilePath]
ghcOptExtra        = [FilePath] -> [FilePath]
Internal.filterGhciFlags
                                           (GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
vanillaOpts)
                                           [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
replFlags,
                      ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs      = Flag (Maybe Int)
forall a. Monoid a => a
mempty
                    }
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
                      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
                    }

      vanillaSharedOpts :: GhcOptions
vanillaSharedOpts = GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend`
                            GhcOptions
forall a. Monoid a => a
mempty {
                              ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode  = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
                              ghcOptDynHiSuffix :: Flag FilePath
ghcOptDynHiSuffix  = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_hi",
                              ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_o",
                              ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir       = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                            }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
forRepl Bool -> Bool -> Bool
|| ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi) Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
jsSrcs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cObjs)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do let vanilla :: IO ()
vanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
forceVanillaLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaOpts)
           shared :: IO ()
shared  = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib  Bool
forceSharedLib  (GhcOptions -> IO ()
runGhcjsProg GhcOptions
sharedOpts)
           useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&&
                       (Bool
forceVanillaLib Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
                       (Bool
forceSharedLib  Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib  LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
                       [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi)
       if Bool
useDynToo
          then do
              GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaSharedOpts
              case (Way -> Flag FilePath
hpcdir Way
Hpc.Dyn, Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla) of
                (Cabal.Flag dynDir :: FilePath
dynDir, Cabal.Flag vanillaDir :: FilePath
vanillaDir) -> do
                    -- 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
                _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else if Bool
isGhcjsDynamic
            then do IO ()
shared;  IO ()
vanilla
            else do IO ()
vanilla; IO ()
shared
       IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
profOpts)

  -- build any C sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources BuildInfo
libBi) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
nativeToo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
     Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Building C Sources..."
     [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
       [ do let vanillaCcOpts :: GhcOptions
vanillaCcOpts =
                  (Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
                     LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
libTargetDir FilePath
filename)
                profCcOpts :: GhcOptions
profCcOpts    = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                  ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                  ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix     = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "p_o"
                                }
                sharedCcOpts :: GhcOptions
sharedCcOpts  = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                                  ghcOptFPic :: Flag Bool
ghcOptFPic        = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                                  ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                                  ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix   = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_o"
                                }
                odir :: FilePath
odir          = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaCcOpts)
            Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
            GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaCcOpts
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
sharedCcOpts)
            IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
profCcOpts)
       | FilePath
filename <- BuildInfo -> [FilePath]
cSources BuildInfo
libBi]

  -- TODO: problem here is we need the .c files built first, so we can load them
  -- with ghci, but .c files can depend on .h files generated by ghc by ffi
  -- exports.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
     IO () -> IO ()
ifReplLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
replOpts)

  -- link:
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nativeToo Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
forRepl) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Linking..."
    let cProfObjs :: [FilePath]
cProfObjs   = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` ("p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
                      (BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
        cSharedObjs :: [FilePath]
cSharedObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` ("dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
                      (BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
        compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
        vanillaLibFilePath :: FilePath
vanillaLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkLibName            UnitId
uid
        profileLibFilePath :: FilePath
profileLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkProfLibName        UnitId
uid
        sharedLibFilePath :: FilePath
sharedLibFilePath  = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
        ghciLibFilePath :: FilePath
ghciLibFilePath    = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
        ghciProfLibFilePath :: FilePath
ghciProfLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid

    [FilePath]
hObjs     <- GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
libTargetDir FilePath
objExtension Bool
True
    [FilePath]
hProfObjs <-
      if (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
              then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
libTargetDir ("p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
True
              else [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [FilePath]
hSharedObjs <-
      if (LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
              then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                      FilePath
libTargetDir ("dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
False
              else [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hObjs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cObjs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do

      let staticObjectFiles :: [FilePath]
staticObjectFiles =
                 [FilePath]
hObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cObjs
          profObjectFiles :: [FilePath]
profObjectFiles =
                 [FilePath]
hProfObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cProfObjs
          dynamicObjectFiles :: [FilePath]
dynamicObjectFiles =
                 [FilePath]
hSharedObjs
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cSharedObjs
          -- After the relocation lib is created we invoke ghc -shared
          -- with the dependencies spelled out as -package arguments
          -- and ghc invokes the linker with the proper library paths
          ghcSharedLinkArgs :: GhcOptions
ghcSharedLinkArgs =
              GhcOptions
forall a. Monoid a => a
mempty {
                ghcOptShared :: Flag Bool
ghcOptShared             = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode        = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles         = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath]
dynamicObjectFiles,
                ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile         = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
sharedLibFilePath,
                ghcOptExtra :: [FilePath]
ghcOptExtra              = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi,
                ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs         = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
                ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages           = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
 -> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a b. (a -> b) -> a -> b
$
                                           ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi,
                ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs           = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
                ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath        = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi
              }

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
vanillaLibFilePath [FilePath]
staticObjectFiles
        IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (ldProg :: ConfiguredProgram
ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
            FilePath
ghciLibFilePath [FilePath]
staticObjectFiles

      IO () -> IO ()
whenProfLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
profileLibFilePath [FilePath]
profObjectFiles
        IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          (ldProg :: ConfiguredProgram
ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
          Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
            FilePath
ghciProfLibFilePath [FilePath]
profObjectFiles

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        GhcOptions -> IO ()
runGhcjsProg GhcOptions
ghcSharedLinkArgs

-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
                 -> PackageDBStack -> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> [PackageDB] -> IO ()
startInterpreter verbosity :: Verbosity
verbosity progdb :: ProgramDb
progdb comp :: Compiler
comp platform :: Platform
platform packageDBs :: [PackageDB]
packageDBs = do
  let replOpts :: GhcOptions
replOpts = GhcOptions
forall a. Monoid a => a
mempty {
        ghcOptMode :: Flag GhcMode
ghcOptMode       = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
        ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = [PackageDB]
packageDBs
        }
  Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
packageDBs
  (ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram ProgramDb
progdb
  Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform GhcOptions
replOpts

buildExe :: Verbosity          -> Cabal.Flag (Maybe Int)
         -> PackageDescription -> LocalBuildInfo
         -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe Maybe [FilePath]
forall a. Maybe a
Nothing

replExe :: [String]                -> Verbosity
        -> Cabal.Flag (Maybe Int)  -> PackageDescription
        -> LocalBuildInfo          -> Executable
        -> ComponentLocalBuildInfo -> IO ()
replExe :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe (Maybe [FilePath]
 -> Verbosity
 -> Flag (Maybe Int)
 -> PackageDescription
 -> LocalBuildInfo
 -> Executable
 -> ComponentLocalBuildInfo
 -> IO ())
-> ([FilePath] -> Maybe [FilePath])
-> [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just

buildOrReplExe :: Maybe [String] -> Verbosity
               -> Cabal.Flag (Maybe Int) -> PackageDescription
               -> LocalBuildInfo -> Executable
               -> ComponentLocalBuildInfo -> IO ()
buildOrReplExe :: Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe mReplFlags :: Maybe [FilePath]
mReplFlags verbosity :: Verbosity
verbosity numJobs :: Flag (Maybe Int)
numJobs _pkg_descr :: PackageDescription
_pkg_descr lbi :: LocalBuildInfo
lbi
  exe :: Executable
exe@Executable { exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
exeName', modulePath :: Executable -> FilePath
modulePath = FilePath
modPath } clbi :: ComponentLocalBuildInfo
clbi = do

  (ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  let forRepl :: Bool
forRepl = Bool -> ([FilePath] -> Bool) -> Maybe [FilePath] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> [FilePath] -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe [FilePath]
mReplFlags
      replFlags :: [FilePath]
replFlags = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [FilePath]
forall a. Monoid a => a
mempty Maybe [FilePath]
mReplFlags
      comp :: Compiler
comp         = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform     = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      implInfo :: GhcImplInfo
implInfo     = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
      runGhcjsProg :: GhcOptions -> IO ()
runGhcjsProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
      exeBi :: BuildInfo
exeBi        = Executable -> BuildInfo
buildInfo Executable
exe

  let exeName'' :: FilePath
exeName'' = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
exeName'
  -- exeNameReal, the name that GHC really uses (with .exe on Windows)
  let exeNameReal :: FilePath
exeNameReal = FilePath
exeName'' FilePath -> FilePath -> FilePath
<.>
                    (if FilePath -> FilePath
takeExtension FilePath
exeName'' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= ('.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Platform -> FilePath
exeExtension Platform
buildPlatform)
                       then Platform -> FilePath
exeExtension Platform
buildPlatform
                       else "")

  let targetDir :: FilePath
targetDir = (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi) FilePath -> FilePath -> FilePath
</> FilePath
exeName''
  let exeDir :: FilePath
exeDir    = FilePath
targetDir FilePath -> FilePath -> FilePath
</> (FilePath
exeName'' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-tmp")
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
targetDir
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
exeDir
  -- 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 = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
      distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
      hpcdir :: Way -> Flag FilePath
hpcdir way :: Way
way
        | Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way FilePath
exeName''
        | Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty

  -- build executables

  FilePath
srcMainFile         <- [FilePath] -> FilePath -> IO FilePath
findFile (FilePath
exeDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
exeBi) FilePath
modPath
  let isGhcjsDynamic :: Bool
isGhcjsDynamic      = Compiler -> Bool
isDynamic Compiler
comp
      dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
      buildRunner :: Bool
buildRunner = case ComponentLocalBuildInfo
clbi of
                      LibComponentLocalBuildInfo   {} -> Bool
False
                      FLibComponentLocalBuildInfo  {} -> Bool
False
                      ExeComponentLocalBuildInfo   {} -> Bool
True
                      TestComponentLocalBuildInfo  {} -> Bool
True
                      BenchComponentLocalBuildInfo {} -> Bool
True
      isHaskellMain :: Bool
isHaskellMain = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
srcMainFile) [".hs", ".lhs"]
      jsSrcs :: [FilePath]
jsSrcs        = BuildInfo -> [FilePath]
jsSources BuildInfo
exeBi
      cSrcs :: [FilePath]
cSrcs         = BuildInfo -> [FilePath]
cSources BuildInfo
exeBi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
srcMainFile | Bool -> Bool
not Bool
isHaskellMain]
      cObjs :: [FilePath]
cObjs         = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cSrcs
      nativeToo :: Bool
nativeToo     = Compiler -> Bool
ghcjsNativeToo Compiler
comp
      baseOpts :: GhcOptions
baseOpts   = (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
exeBi ComponentLocalBuildInfo
clbi FilePath
exeDir)
                    GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles   = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                        [ FilePath
srcMainFile | Bool
isHaskellMain],
                      ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$
                        [ ModuleName
m | Bool -> Bool
not Bool
isHaskellMain, ModuleName
m <- Executable -> [ModuleName]
exeModules Executable
exe],
                      ghcOptExtra :: [FilePath]
ghcOptExtra =
                        if Bool
buildRunner then ["-build-runner"]
                                       else [FilePath]
forall a. Monoid a => a
mempty
                    }
      staticOpts :: GhcOptions
staticOpts = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticOnly,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
                   }
      profOpts :: GhcOptions
profOpts   = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "p_hi" "p_o" GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                      ghcOptExtra :: [FilePath]
ghcOptExtra          = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
exeBi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
                    }
      dynOpts :: GhcOptions
dynOpts    = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
                      ghcOptExtra :: [FilePath]
ghcOptExtra          = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
exeBi,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }
      dynTooOpts :: GhcOptions
dynTooOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
staticOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode    = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
                      ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir         = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
                    }
      linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions    = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
exeBi,
                      ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs       = BuildInfo -> [FilePath]
extraLibs BuildInfo
exeBi,
                      ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath    = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
exeBi,
                      ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
exeBi,
                      ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles     = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
                                             [FilePath
exeDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cObjs] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
jsSrcs
                   }
      replOpts :: GhcOptions
replOpts   = GhcOptions
baseOpts {
                      ghcOptExtra :: [FilePath]
ghcOptExtra          = [FilePath] -> [FilePath]
Internal.filterGhciFlags
                                             (GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
baseOpts)
                                             [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
replFlags
                   }
                   -- For a normal compile we do separate invocations of ghc for
                   -- compiling as for linking. But for repl we have to do just
                   -- the one invocation, so that one has to include all the
                   -- linker stuff too, like -l flags and any .o files from C
                   -- files etc.
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
                   GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptMode :: Flag GhcMode
ghcOptMode           = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
                      ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation   = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
                   }
      commonOpts :: GhcOptions
commonOpts  | LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi = GhcOptions
profOpts
                  | LocalBuildInfo -> Bool
withDynExe  LocalBuildInfo
lbi = GhcOptions
dynOpts
                  | Bool
otherwise       = GhcOptions
staticOpts
      compileOpts :: GhcOptions
compileOpts | Bool
useDynToo = GhcOptions
dynTooOpts
                  | Bool
otherwise = GhcOptions
commonOpts
      withStaticExe :: Bool
withStaticExe = (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi)

      -- For building exe's that use TH with -prof or -dynamic we actually have
      -- to build twice, once without -prof/-dynamic and then again with
      -- -prof/-dynamic. 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.
      doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
exeBi
      -- Should we use -dynamic-too instead of compiling twice?
      useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&& Bool
isGhcjsDynamic
                  Bool -> Bool -> Bool
&& Bool
doingTH Bool -> Bool -> Bool
&& Bool
withStaticExe Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
exeBi)
      compileTHOpts :: GhcOptions
compileTHOpts | Bool
isGhcjsDynamic = GhcOptions
dynOpts
                    | Bool
otherwise      = GhcOptions
staticOpts
      compileForTH :: Bool
compileForTH
        | Bool
forRepl      = Bool
False
        | Bool
useDynToo    = Bool
False
        | Bool
isGhcjsDynamic = Bool
doingTH Bool -> Bool -> Bool
&& (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi Bool -> Bool -> Bool
|| Bool
withStaticExe)
        | Bool
otherwise      = Bool
doingTH Bool -> Bool -> Bool
&& (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi)

      linkOpts :: GhcOptions
linkOpts = GhcOptions
commonOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend`
                 GhcOptions
linkerOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                      ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain   = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (Bool -> Bool
not Bool
isHaskellMain)
                 }

  -- Build static/dynamic object files for TH, if needed.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
compileForTH (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    GhcOptions -> IO ()
runGhcjsProg GhcOptions
compileTHOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                               , ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    GhcOptions -> IO ()
runGhcjsProg GhcOptions
compileOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink  = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
                             , ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }

  -- build any C sources
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cSrcs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
nativeToo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Building C Sources..."
   [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
     [ do let opts :: GhcOptions
opts = (Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
exeBi
                         ComponentLocalBuildInfo
clbi FilePath
exeDir FilePath
filename) GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                       ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode   = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
                                                       then GhcDynLinkMode
GhcDynamicOnly
                                                       else GhcDynLinkMode
GhcStaticOnly),
                       ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi)
                     }
              odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
          Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
          GhcOptions -> IO ()
runGhcjsProg GhcOptions
opts
     | FilePath
filename <- [FilePath]
cSrcs ]

  -- TODO: problem here is we need the .c files built first, so we can load them
  -- with ghci, but .c files can depend on .h files generated by ghc by ffi
  -- exports.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcjsProg GhcOptions
replOpts

  -- link:
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Linking..."
    GhcOptions -> IO ()
runGhcjsProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
exeNameReal) }

-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib    :: Verbosity
              -> LocalBuildInfo
              -> FilePath  -- ^install location
              -> FilePath  -- ^install location for dynamic libraries
              -> FilePath  -- ^Build location
              -> PackageDescription
              -> Library
              -> ComponentLocalBuildInfo
              -> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi targetDir :: FilePath
targetDir dynlibTargetDir :: FilePath
dynlibTargetDir builtDir :: FilePath
builtDir _pkg :: PackageDescription
_pkg lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
  IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_hi"
  IO () -> IO ()
whenProf    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_p_hi"
  IO () -> IO ()
whenShared  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_dyn_hi"

  IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
vanillaLibName
  IO () -> IO ()
whenProf    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
profileLibName
  IO () -> IO ()
whenShared  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installShared   FilePath
builtDir FilePath
dynlibTargetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
sharedLibName

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Bool
ghcjsNativeToo (Compiler -> Bool) -> Compiler -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- copy .hi files over:
    IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "hi"
    IO () -> IO ()
whenProf    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "p_hi"
    IO () -> IO ()
whenShared  (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "dyn_hi"

    -- copy the built library files over:
    IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
vanillaLibName
      IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
ghciLibName
    IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
profileLibName
      IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
ghciProfLibName
    IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installSharedNative FilePath
builtDir FilePath
dynlibTargetDir FilePath
sharedLibName

  where
    install :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install isShared :: Bool
isShared isJS :: Bool
isJS srcDir :: FilePath
srcDir dstDir :: FilePath
dstDir name :: FilePath
name = do
      let src :: FilePath
src = FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
name
          dst :: FilePath
dst = FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
name
      Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
dstDir

      if Bool
isShared
        then Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
dst
        else Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile   Verbosity
verbosity FilePath
src FilePath
dst

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripLibs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isJS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
Strip.stripLib Verbosity
verbosity
        (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) FilePath
dst

    installOrdinary :: FilePath -> FilePath -> FilePath -> IO ()
installOrdinary = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
False Bool
True
    installShared :: FilePath -> FilePath -> FilePath -> IO ()
installShared   = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
True  Bool
True

    installOrdinaryNative :: FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
False Bool
False
    installSharedNative :: FilePath -> FilePath -> FilePath -> IO ()
installSharedNative   = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
True  Bool
False

    copyModuleFiles :: FilePath -> IO ()
copyModuleFiles ext :: FilePath
ext =
      [FilePath]
-> [FilePath] -> [ModuleName] -> IO [(FilePath, FilePath)]
findModuleFiles [FilePath
builtDir] [FilePath
ext] (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
      IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles Verbosity
verbosity FilePath
targetDir

    compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
    vanillaLibName :: FilePath
vanillaLibName = UnitId -> FilePath
mkLibName              UnitId
uid
    profileLibName :: FilePath
profileLibName = UnitId -> FilePath
mkProfLibName          UnitId
uid
    ghciLibName :: FilePath
ghciLibName    = UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
    ghciProfLibName :: FilePath
ghciProfLibName = UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid
    sharedLibName :: FilePath
sharedLibName  = (Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id)  UnitId
uid

    hasLib :: Bool
hasLib    = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
                   Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources (Library -> BuildInfo
libBuildInfo Library
lib))
    whenVanilla :: IO () -> IO ()
whenVanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
    whenProf :: IO () -> IO ()
whenProf    = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib    LocalBuildInfo
lbi)
    whenGHCi :: IO () -> IO ()
whenGHCi    = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withGHCiLib    LocalBuildInfo
lbi)
    whenShared :: IO () -> IO ()
whenShared  = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withSharedLib  LocalBuildInfo
lbi)

installExe :: Verbosity
              -> LocalBuildInfo
              -> FilePath -- ^Where to copy the files to
              -> FilePath  -- ^Build location
              -> (FilePath, FilePath)  -- ^Executable (prefix,suffix)
              -> PackageDescription
              -> Executable
              -> IO ()
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi binDir :: FilePath
binDir buildPref :: FilePath
buildPref
           (progprefix :: FilePath
progprefix, progsuffix :: FilePath
progsuffix) _pkg :: PackageDescription
_pkg exe :: Executable
exe = do
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
binDir
  let exeName' :: FilePath
exeName' = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
      exeFileName :: FilePath
exeFileName = FilePath
exeName'
      fixedExeBaseName :: FilePath
fixedExeBaseName = FilePath
progprefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exeName' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
progsuffix
      installBinary :: FilePath -> IO ()
installBinary dest :: FilePath
dest = do
        Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
          [ "--install-executable"
          , FilePath
buildPref FilePath -> FilePath -> FilePath
</> FilePath
exeName' FilePath -> FilePath -> FilePath
</> FilePath
exeFileName
          , "-o", FilePath
dest
          ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
          case (LocalBuildInfo -> Bool
stripExes LocalBuildInfo
lbi, Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
stripProgram (ProgramDb -> Maybe ConfiguredProgram)
-> ProgramDb -> Maybe ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) of
           (True, Just strip :: ConfiguredProgram
strip) -> ["-strip-program", ConfiguredProgram -> FilePath
programPath ConfiguredProgram
strip]
           _                  -> []
  FilePath -> IO ()
installBinary (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fixedExeBaseName)

libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
           -> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
libAbiHash verbosity :: Verbosity
verbosity _pkg_descr :: PackageDescription
_pkg_descr lbi :: LocalBuildInfo
lbi lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
  let
      libBi :: BuildInfo
libBi       = Library -> BuildInfo
libBuildInfo Library
lib
      comp :: Compiler
comp        = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      platform :: Platform
platform    = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
      vanillaArgs :: GhcOptions
vanillaArgs =
        (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi))
        GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
          ghcOptMode :: Flag GhcMode
ghcOptMode         = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeAbiHash,
          ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
PD.exposedModules Library
lib
        }
      profArgs :: GhcOptions
profArgs = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "js_p_hi" "js_p_o" GhcOptions
vanillaArgs GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
                     ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
                     ghcOptExtra :: [FilePath]
ghcOptExtra         = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
libBi
                 }
      ghcArgs :: GhcOptions
ghcArgs | LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi = GhcOptions
vanillaArgs
              | LocalBuildInfo -> Bool
withProfLib    LocalBuildInfo
lbi = GhcOptions
profArgs
              | Bool
otherwise = FilePath -> GhcOptions
forall a. HasCallStack => FilePath -> a
error "libAbiHash: Can't find an enabled library way"
  --
  (ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
  FilePath
hash <- Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput Verbosity
verbosity
          (ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform GhcOptions
ghcArgs)
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) FilePath
hash)

adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts :: FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts hiSuf :: FilePath
hiSuf objSuf :: FilePath
objSuf opts :: GhcOptions
opts =
  GhcOptions
opts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
    ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix  = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
hiSuf,
    ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
objSuf
  }

registerPackage :: Verbosity
                -> ProgramDb
                -> PackageDBStack
                -> InstalledPackageInfo
                -> HcPkg.RegisterOptions
                -> IO ()
registerPackage :: Verbosity
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage verbosity :: Verbosity
verbosity progdb :: ProgramDb
progdb packageDbs :: [PackageDB]
packageDbs installedPkgInfo :: InstalledPackageInfo
installedPkgInfo registerOptions :: RegisterOptions
registerOptions =
    HcPkgInfo
-> Verbosity
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
HcPkg.register (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity [PackageDB]
packageDbs
                   InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions

componentGhcOptions :: Verbosity -> LocalBuildInfo
                    -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
                    -> GhcOptions
componentGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi bi :: BuildInfo
bi clbi :: ComponentLocalBuildInfo
clbi odir :: FilePath
odir =
  let opts :: GhcOptions
opts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi FilePath
odir
      comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
      implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
  in  GhcOptions
opts { ghcOptExtra :: [FilePath]
ghcOptExtra = GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHCJS BuildInfo
bi
           }

ghcjsProfOptions :: BuildInfo -> [String]
ghcjsProfOptions :: BuildInfo -> [FilePath]
ghcjsProfOptions bi :: BuildInfo
bi =
  CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHCJS BuildInfo
bi

ghcjsSharedOptions :: BuildInfo -> [String]
ghcjsSharedOptions :: BuildInfo -> [FilePath]
ghcjsSharedOptions bi :: BuildInfo
bi =
  CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHCJS BuildInfo
bi

isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "GHC Dynamic"

supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "Support dynamic-too"

findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion verbosity :: Verbosity
verbosity pgm :: FilePath
pgm =
  FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion "--numeric-ghc-version" FilePath -> FilePath
forall a. a -> a
id Verbosity
verbosity FilePath
pgm

findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion verbosity :: Verbosity
verbosity pgm :: FilePath
pgm =
  FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion "--numeric-ghcjs-version" FilePath -> FilePath
forall a. a -> a
id Verbosity
verbosity FilePath
pgm

-- -----------------------------------------------------------------------------
-- Registering

hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo :: ProgramDb -> HcPkgInfo
hcPkgInfo progdb :: ProgramDb
progdb = HcPkgInfo :: ConfiguredProgram
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> HcPkgInfo
HcPkg.HcPkgInfo { hcPkgProgram :: ConfiguredProgram
HcPkg.hcPkgProgram    = ConfiguredProgram
ghcjsPkgProg
                                   , noPkgDbStack :: Bool
HcPkg.noPkgDbStack    = Bool
False
                                   , noVerboseFlag :: Bool
HcPkg.noVerboseFlag   = Bool
False
                                   , flagPackageConf :: Bool
HcPkg.flagPackageConf = Bool
False
                                   , supportsDirDbs :: Bool
HcPkg.supportsDirDbs  = Bool
True
                                   , requiresDirDbs :: Bool
HcPkg.requiresDirDbs  = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
                                   , nativeMultiInstance :: Bool
HcPkg.nativeMultiInstance  = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
                                   , recacheMultiInstance :: Bool
HcPkg.recacheMultiInstance = Bool
True
                                   , suppressFilesCheck :: Bool
HcPkg.suppressFilesCheck   = Bool
True
                                   }
  where
    v7_10 :: Version
v7_10 = [Int] -> Version
mkVersion [7,10]
    Just ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsPkgProgram ProgramDb
progdb
    Just ver :: Version
ver          = ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsPkgProg

-- | Get the JavaScript file name and command and arguments to run a
--   program compiled by GHCJS
--   the exe should be the base program name without exe extension
runCmd :: ProgramDb -> FilePath
            -> (FilePath, FilePath, [String])
runCmd :: ProgramDb -> FilePath -> (FilePath, FilePath, [FilePath])
runCmd progdb :: ProgramDb
progdb exe :: FilePath
exe =
  ( FilePath
script
  , ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
  , ConfiguredProgram -> [FilePath]
programDefaultArgs ConfiguredProgram
ghcjsProg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [FilePath]
programOverrideArgs ConfiguredProgram
ghcjsProg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["--run"]
  )
  where
    script :: FilePath
script = FilePath
exe FilePath -> FilePath -> FilePath
<.> "jsexe" FilePath -> FilePath -> FilePath
</> "all" FilePath -> FilePath -> FilePath
<.> "js"
    Just ghcjsProg :: ConfiguredProgram
ghcjsProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb