{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}
module Distribution.Simple.GHCJS (
getGhcInfo,
configure,
getInstalledPackages,
getInstalledPackagesMonitorFiles,
getPackageDBContents,
buildLib, buildFLib, buildExe,
replLib, replFLib, replExe,
startInterpreter,
installLib, installFLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
componentCcGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
pkgRoot,
runCmd,
Internal.GhcEnvironmentFileEntry(..),
Internal.simpleGhcEnvironmentFile,
Internal.renderGhcEnvironmentFile,
Internal.writeGhcEnvironmentFile,
Internal.ghcPlatformAndVersionString,
readGhcEnvironmentFile,
parseGhcEnvironmentFile,
ParseErrorExc(..),
getImplInfo,
GhcImplInfo(..)
) where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentLocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler
import Distribution.CabalSpecVersion
import Distribution.Version
import Distribution.System
import Distribution.Verbosity
import Distribution.Pretty
import Distribution.Utils.NubList
import Control.Monad (msum)
import Data.Char (isLower)
import qualified Data.Map as Map
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile, renameFile )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension
,isRelative )
import qualified System.Info
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 Maybe FilePath
hcPath Maybe FilePath
hcPkgPath ProgramDb
conf0 = do
(ConfiguredProgram
ghcjsProg, Version
ghcjsVersion, ProgramDb
progdb1) <-
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcjsProgram
(Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
0,Int
1]))
(FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath FilePath
"ghcjs" Maybe FilePath
hcPath ProgramDb
conf0)
Just Version
ghcjsGhcVersion <- Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Version
ghcjsGhcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
8,Int
8]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Unknown/unsupported 'ghc' version detected "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(Cabal " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
cabalVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" supports 'ghc' version < 8.8): "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is based on GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsGhcVersion
let implInfo :: GhcImplInfo
implInfo = Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo Version
ghcjsVersion Version
ghcjsGhcVersion
(ConfiguredProgram
ghcjsPkgProg, Version
ghcjsPkgVersion, 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 FilePath
"ghcjs-pkg" Maybe FilePath
hcPkgPath ProgramDb
progdb1)
Just 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
$
FilePath
"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]
++ FilePath
" 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 -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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
$
FilePath
"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]
++ FilePath
" 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 -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" was built with GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsPkgVersion
let hsc2hsProgram' :: Program
hsc2hsProgram' = Program
hsc2hsProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath 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
}
hpcProgram' :: Program
hpcProgram' = Program
hpcProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcjsPath ConfiguredProgram
ghcjsProg
}
progdb3 :: ProgramDb
progdb3 = Program -> ProgramDb -> ProgramDb
addKnownProgram Program
haddockProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hsc2hsProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hpcProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
ProgramDb
progdb2
[(Language, FilePath)]
languages <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(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)]
ghcjsInfo <- 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)]
ghcjsInfo
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
$
FilePath
"ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_" ((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)]
ghcjsInfo
(Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
compPlatform, ProgramDb
progdb3)
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
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
guessHpcFromGhcjsPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
hpcProgram
guessToolFromGhcjsPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath :: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
tool ConfiguredProgram
ghcjsProg Verbosity
verbosity ProgramSearchPath
searchpath
= do let toolname :: FilePath
toolname = Program -> FilePath
programName Program
tool
given_path :: FilePath
given_path = ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
given_dir :: FilePath
given_dir = FilePath -> FilePath
takeDirectory FilePath
given_path
FilePath
real_path <- FilePath -> IO FilePath
canonicalizePath FilePath
given_path
let real_dir :: FilePath
real_dir = FilePath -> FilePath
takeDirectory FilePath
real_path
versionSuffix :: FilePath -> FilePath
versionSuffix FilePath
path = FilePath -> FilePath
takeVersionSuffix (FilePath -> FilePath
dropExeExtension FilePath
path)
given_suf :: FilePath
given_suf = FilePath -> FilePath
versionSuffix FilePath
given_path
real_suf :: FilePath
real_suf = FilePath -> FilePath
versionSuffix FilePath
real_path
guessNormal :: FilePath -> FilePath
guessNormal FilePath
dir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
toolname FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessGhcjs :: FilePath -> FilePath
guessGhcjs FilePath
dir = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-ghcjs")
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessGhcjsVersioned :: FilePath -> FilePath -> FilePath
guessGhcjsVersioned FilePath
dir FilePath
suf = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-ghcjs" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suf)
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessVersioned :: FilePath -> FilePath -> FilePath
guessVersioned FilePath
dir FilePath
suf = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suf)
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
mkGuesses :: FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
dir FilePath
suf | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
suf = [FilePath -> FilePath
guessGhcjs FilePath
dir, FilePath -> FilePath
guessNormal FilePath
dir]
| Bool
otherwise = [FilePath -> FilePath -> FilePath
guessGhcjsVersioned FilePath
dir FilePath
suf,
FilePath -> FilePath -> FilePath
guessVersioned FilePath
dir FilePath
suf,
FilePath -> FilePath
guessGhcjs FilePath
dir,
FilePath -> FilePath
guessNormal FilePath
dir]
guesses :: [FilePath]
guesses = FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
given_dir FilePath
given_suf [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
if FilePath
real_path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
given_path
then []
else FilePath -> FilePath -> [FilePath]
mkGuesses FilePath
real_dir FilePath
real_suf
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"looking for tool " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" near compiler in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
given_dir
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"candidate locations: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
guesses
[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 | (FilePath
file, Bool
True) <- [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists ] of
[] -> Program
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
programFindLocation Program
tool Verbosity
verbosity ProgramSearchPath
searchpath
(FilePath
fp:[FilePath]
_) -> do Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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 (\(FilePath
_file, 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 = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEndLE Char -> Bool
isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar :: Char -> Bool
isSuffixChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(FilePath, FilePath)]
getGhcInfo Verbosity
verbosity ConfiguredProgram
ghcjsProg = Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(FilePath, FilePath)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
where
version :: Version
version = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.getGhcInfo: no version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsProg
implInfo :: GhcImplInfo
implInfo = Version -> GhcImplInfo
ghcVersionImplInfo Version
version
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents Verbosity
verbosity PackageDB
packagedb 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
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages :: Verbosity -> [PackageDB] -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity [PackageDB]
packagedbs 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 [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb = do
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)
| (PackageDB
_, [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
ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.toPackageIndex no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir Verbosity
verbosity LocalBuildInfo
lbi =
(Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (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) [FilePath
"--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg =
(Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (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 [FilePath
"--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg =
(Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace (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
ghcProg [FilePath
"--print-global-package-db"]
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB Verbosity
_verbosity ConfiguredProgram
ghcjsProg Platform
platform = do
FilePath
appdir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"ghcjs"
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
appdir FilePath -> FilePath -> FilePath
</> FilePath
platformAndVersion FilePath -> FilePath -> FilePath
</> FilePath
packageConfFileName)
where
platformAndVersion :: FilePath
platformAndVersion = Platform -> Version -> FilePath
Internal.ghcPlatformAndVersionString
Platform
platform Version
ghcjsVersion
packageConfFileName :: FilePath
packageConfFileName = FilePath
"package.conf.d"
ghcjsVersion :: Version
ghcjsVersion = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.getUserPackageDB: no version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity =
Verbosity -> FilePath -> FilePath -> IO ()
Internal.checkPackageDbEnvVar Verbosity
verbosity FilePath
"GHCJS" FilePath
"GHCJS_PACKAGE_PATH"
checkPackageDbStack :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStack :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
_ (PackageDB
GlobalPackageDB:[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 [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
$ FilePath
"With current ghc versions the global package db is always used "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"and must be listed first. This ghc limitation may be lifted in "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"future, see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"
checkPackageDbStack Verbosity
verbosity [PackageDB]
_ =
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"If the global package db is specified, it must be "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"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 [PackageDB]
packagedbs 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 ]
getInstalledPackagesMonitorFiles :: Verbosity -> Platform
-> ProgramDb
-> [PackageDB]
-> IO [FilePath]
getInstalledPackagesMonitorFiles :: Verbosity -> Platform -> ProgramDb -> [PackageDB] -> IO [FilePath]
getInstalledPackagesMonitorFiles Verbosity
verbosity Platform
platform ProgramDb
progdb =
(PackageDB -> IO FilePath) -> [PackageDB] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PackageDB -> IO FilePath
getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath PackageDB
GlobalPackageDB =
FilePath -> IO FilePath
selectMonitorFile (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg
getPackageDBPath PackageDB
UserPackageDB =
FilePath -> IO FilePath
selectMonitorFile (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg Platform
platform
getPackageDBPath (SpecificPackageDB FilePath
path) = FilePath -> IO FilePath
selectMonitorFile FilePath
path
selectMonitorFile :: FilePath -> IO FilePath
selectMonitorFile FilePath
path = do
Bool
isFileStyle <- FilePath -> IO Bool
doesFileExist FilePath
path
if Bool
isFileStyle then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"package.cache")
ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.toPackageIndex no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
toJSLibName :: String -> String
toJSLibName :: FilePath -> FilePath
toJSLibName FilePath
lib
| FilePath -> FilePath
takeExtension FilePath
lib FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".dll",FilePath
".dylib",FilePath
".so"]
= FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib FilePath
"js_so"
| FilePath -> FilePath
takeExtension FilePath
lib FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".a" = FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib FilePath
"js_a"
| Bool
otherwise = FilePath
lib FilePath -> 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 ()
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 Maybe [FilePath]
mReplFlags Verbosity
verbosity Flag (Maybe Int)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = do
let uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
libTargetDir :: FilePath
libTargetDir = LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
whenVanillaLib :: Bool -> f () -> f ()
whenVanillaLib Bool
forceVanilla =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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 (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
whenSharedLib :: Bool -> f () -> f ()
whenSharedLib Bool
forceShared =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceShared Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
whenStaticLib :: Bool -> f () -> f ()
whenStaticLib Bool
forceStatic =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceStatic Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withStaticLib 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
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
platform :: Platform
platform@(Platform Arch
_hostArch OS
_hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
has_code :: Bool
has_code = Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
(ConfiguredProgram
ghcjsProg, ProgramDb
_) <- 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
let libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib
let 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
let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi
pkg_name :: FilePath
pkg_name = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (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
| Bool
forRepl = Flag FilePath
forall a. Monoid a => a
mempty
| 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
let cLikeFiles :: [FilePath]
cLikeFiles = NubListR FilePath -> [FilePath]
forall a. NubListR a -> [a]
fromNubListR (NubListR FilePath -> [FilePath])
-> NubListR FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
cSources BuildInfo
libBi) NubListR FilePath -> NubListR FilePath -> NubListR FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [FilePath]
cxxSources BuildInfo
libBi)
jsSrcs :: [FilePath]
jsSrcs = BuildInfo -> [FilePath]
jsSources BuildInfo
libBi
cObjs :: [FilePath]
cObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cLikeFiles
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 =
[ FilePath
"-link-js-lib" , UnitId -> FilePath
getHSLibraryName UnitId
uid
, FilePath
"-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 FilePath
"p_hi" FilePath
"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,
ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
True
(LocalBuildInfo -> ProfDetailLevel
withProfLibDetail LocalBuildInfo
lbi),
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
}
sharedOpts :: GhcOptions
sharedOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts FilePath
"dyn_hi" FilePath
"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 = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
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 FilePath
"js_dyn_hi",
ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"js_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 (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi)
if Bool -> Bool
not Bool
has_code
then IO ()
vanilla
else
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 FilePath
dynDir, Cabal.Flag FilePath
vanillaDir) ->
Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive Verbosity
verbosity FilePath
dynDir FilePath
vanillaDir
(Flag FilePath, Flag FilePath)
_ -> () -> 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)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 FilePath
"Linking..."
let cSharedObjs :: [FilePath]
cSharedObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` (FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
(BuildInfo -> [FilePath]
cSources BuildInfo
libBi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
cxxSources BuildInfo
libBi)
compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
sharedLibFilePath :: FilePath
sharedLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
staticLibFilePath :: FilePath
staticLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> Platform -> CompilerId -> UnitId -> FilePath
mkStaticLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
let stubObjs :: [a]
stubObjs = []
stubSharedObjs :: [a]
stubSharedObjs = []
[FilePath]
hObjs <- GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
FilePath
libTargetDir FilePath
objExtension Bool
True
[FilePath]
hSharedObjs <-
if LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi
then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> IO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
FilePath
libTargetDir (FilePath
"dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
False
else [FilePath] -> IO [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 Bool -> Bool -> Bool
&& [Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Any]
forall a. [a]
stubObjs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
NubListR FilePath
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
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
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
forall a. [a]
stubObjs
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
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
forall a. [a]
stubSharedObjs
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 = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
ghcOptThisUnitId :: Flag FilePath
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey = FilePath
pk }
-> FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
pk
ComponentLocalBuildInfo
_ -> Flag FilePath
forall a. Monoid a => a
mempty,
ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } ->
if [(ModuleName, OpenModule)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then Flag ComponentId
forall a. Monoid a => a
mempty
else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty,
ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
ghcOptInstantiatedWith = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts }
-> [(ModuleName, OpenModule)]
insts
ComponentLocalBuildInfo
_ -> [],
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,
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,
ghcOptLinkFrameworkDirs :: NubListR FilePath
ghcOptLinkFrameworkDirs =
[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.extraFrameworkDirs BuildInfo
libBi,
ghcOptRPaths :: NubListR FilePath
ghcOptRPaths = NubListR FilePath
rpaths
}
ghcStaticLinkArgs :: GhcOptions
ghcStaticLinkArgs =
GhcOptions
forall a. Monoid a => a
mempty {
ghcOptStaticLib :: Flag Bool
ghcOptStaticLib = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath]
staticObjectFiles,
ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
staticLibFilePath,
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcStaticOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
ghcOptThisUnitId :: Flag FilePath
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey = FilePath
pk }
-> FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
pk
ComponentLocalBuildInfo
_ -> Flag FilePath
forall a. Monoid a => a
mempty,
ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } ->
if [(ModuleName, OpenModule)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then Flag ComponentId
forall a. Monoid a => a
mempty
else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty,
ghcOptInstantiatedWith :: [(ModuleName, OpenModule)]
ghcOptInstantiatedWith = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts }
-> [(ModuleName, OpenModule)]
insts
ComponentLocalBuildInfo
_ -> [],
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
}
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (NubListR (OpenUnitId, ModuleRenaming) -> FilePath
forall a. Show a => a -> FilePath
show (GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages GhcOptions
ghcSharedLinkArgs))
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenStaticLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcjsProg GhcOptions
ghcStaticLinkArgs
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
-> PackageDBStack -> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> [PackageDB] -> IO ()
startInterpreter Verbosity
verbosity ProgramDb
progdb Compiler
comp Platform
platform [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
(ConfiguredProgram
ghcjsProg, ProgramDb
_) <- 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
buildFLib
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> ForeignLib -> ComponentLocalBuildInfo -> IO ()
buildFLib :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> GBuildMode
GBuildFLib
replFLib
:: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> ForeignLib
-> ComponentLocalBuildInfo -> IO ()
replFLib :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib [FilePath]
replFlags Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi =
Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ForeignLib -> GBuildMode
GReplFLib [FilePath]
replFlags
buildExe
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> GBuildMode
GBuildExe
replExe
:: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Executable
-> ComponentLocalBuildInfo -> IO ()
replExe :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe [FilePath]
replFlags Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi =
Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag (Maybe Int)
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Executable -> GBuildMode
GReplExe [FilePath]
replFlags
data GBuildMode =
GBuildExe Executable
| GReplExe [String] Executable
| GBuildFLib ForeignLib
| GReplFLib [String] ForeignLib
gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo (GBuildExe Executable
exe) = Executable -> BuildInfo
buildInfo Executable
exe
gbuildInfo (GReplExe [FilePath]
_ Executable
exe) = Executable -> BuildInfo
buildInfo Executable
exe
gbuildInfo (GBuildFLib ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
gbuildInfo (GReplFLib [FilePath]
_ ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
gbuildName :: GBuildMode -> String
gbuildName :: GBuildMode -> FilePath
gbuildName (GBuildExe Executable
exe) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GReplExe [FilePath]
_ Executable
exe) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GBuildFLib ForeignLib
flib) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildName (GReplFLib [FilePath]
_ ForeignLib
flib) = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> FilePath
gbuildTargetName LocalBuildInfo
lbi (GBuildExe Executable
exe) = Platform -> Executable -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GReplExe [FilePath]
_ Executable
exe) = Platform -> Executable -> FilePath
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GBuildFLib ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
gbuildTargetName LocalBuildInfo
lbi (GReplFLib [FilePath]
_ ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
exeTargetName :: Platform -> Executable -> String
exeTargetName :: Platform -> Executable -> FilePath
exeTargetName Platform
platform Executable
exe = UnqualComponentName -> FilePath
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) FilePath -> FilePath -> FilePath
`withExt` Platform -> FilePath
exeExtension Platform
platform
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName :: LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib =
case (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) of
(OS
Windows, ForeignLibType
ForeignLibNativeShared) -> FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"dll"
(OS
Windows, ForeignLibType
ForeignLibNativeStatic) -> FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
"lib"
(OS
Linux, ForeignLibType
ForeignLibNativeShared) -> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> FilePath
versionedExt
(OS
_other, ForeignLibType
ForeignLibNativeShared) -> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_other, ForeignLibType
ForeignLibNativeStatic) -> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_any, ForeignLibType
ForeignLibTypeUnknown) -> FilePath -> FilePath
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
where
nm :: String
nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
os :: OS
os :: OS
os = let (Platform Arch
_ OS
os') = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
in OS
os'
versionedExt :: String
versionedExt :: FilePath
versionedExt =
let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int]
nums)
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName :: LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
| (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) (OS, ForeignLibType) -> (OS, ForeignLibType) -> Bool
forall a. Eq a => a -> a -> Bool
==
(OS
Linux, ForeignLibType
ForeignLibNativeShared)
= let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
nm FilePath -> FilePath -> FilePath
<.> (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
(<.>) FilePath
"so" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
1 [Int]
nums))
| Bool
otherwise = LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
where
os :: OS
os :: OS
os = let (Platform Arch
_ OS
os') = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
in OS
os'
nm :: String
nm :: FilePath
nm = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl (GBuildExe Executable
_) = Bool
False
gbuildIsRepl (GReplExe [FilePath]
_ Executable
_) = Bool
True
gbuildIsRepl (GBuildFLib ForeignLib
_) = Bool
False
gbuildIsRepl (GReplFLib [FilePath]
_ ForeignLib
_) = Bool
True
gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic LocalBuildInfo
lbi GBuildMode
bm =
case GBuildMode
bm of
GBuildExe Executable
_ -> LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
GReplExe [FilePath]
_ Executable
_ -> LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
GBuildFLib ForeignLib
flib -> ForeignLib -> Bool
withDynFLib ForeignLib
flib
GReplFLib [FilePath]
_ ForeignLib
flib -> ForeignLib -> Bool
withDynFLib ForeignLib
flib
where
withDynFLib :: ForeignLib -> Bool
withDynFLib ForeignLib
flib =
case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
ForeignLibType
ForeignLibNativeShared ->
ForeignLibOption
ForeignLibStandalone ForeignLibOption -> [ForeignLibOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib
ForeignLibType
ForeignLibNativeStatic ->
Bool
False
ForeignLibType
ForeignLibTypeUnknown ->
FilePath -> Bool
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles (GBuildExe Executable
_) = []
gbuildModDefFiles (GReplExe [FilePath]
_ Executable
_) = []
gbuildModDefFiles (GBuildFLib ForeignLib
flib) = ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib
gbuildModDefFiles (GReplFLib [FilePath]
_ ForeignLib
flib) = ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo} =
[Maybe ModuleName] -> Maybe ModuleName
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ModuleName] -> Maybe ModuleName)
-> [Maybe ModuleName] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ [Maybe ModuleName] -> [Maybe ModuleName]
forall a. [a] -> [a]
reverse ([Maybe ModuleName] -> [Maybe ModuleName])
-> [Maybe ModuleName] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe ModuleName) -> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe ModuleName
decodeMainIsArg ([FilePath] -> [Maybe ModuleName])
-> [FilePath] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
ghcopts
where
ghcopts :: [FilePath]
ghcopts = CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHC BuildInfo
bnfo
findIsMainArgs :: [FilePath] -> [FilePath]
findIsMainArgs [] = []
findIsMainArgs (FilePath
"-main-is":FilePath
arg:[FilePath]
rest) = FilePath
arg FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
rest
findIsMainArgs (FilePath
_:[FilePath]
rest) = [FilePath] -> [FilePath]
findIsMainArgs [FilePath]
rest
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg :: FilePath -> Maybe ModuleName
decodeMainIsArg FilePath
arg
| FilePath -> (Char -> Bool) -> Bool
headOf FilePath
main_fn Char -> Bool
isLower
= ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
main_mod)
| FilePath -> (Char -> Bool) -> Bool
headOf FilePath
arg Char -> Bool
isUpper
= ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
arg)
| Bool
otherwise
= Maybe ModuleName
forall a. Maybe a
Nothing
where
headOf :: String -> (Char -> Bool) -> Bool
headOf :: FilePath -> (Char -> Bool) -> Bool
headOf FilePath
str Char -> Bool
pred' = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' (FilePath -> Maybe Char
forall a. [a] -> Maybe a
safeHead FilePath
str)
(FilePath
main_mod, FilePath
main_fn) = FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
arg (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix :: FilePath -> (Char -> Bool) -> (FilePath, FilePath)
splitLongestPrefix FilePath
str Char -> Bool
pred'
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r_pre = (FilePath
str, [])
| Bool
otherwise = (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath
forall a. [a] -> [a]
safeTail FilePath
r_pre), FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
r_suf)
where (FilePath
r_suf, FilePath
r_pre) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
str)
data BuildSources = BuildSources {
BuildSources -> [FilePath]
cSourcesFiles :: [FilePath],
BuildSources -> [FilePath]
cxxSourceFiles :: [FilePath],
BuildSources -> [FilePath]
inputSourceFiles :: [FilePath],
BuildSources -> [ModuleName]
inputSourceModules :: [ModuleName]
}
gbuildSources :: Verbosity
-> CabalSpecVersion
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources :: Verbosity
-> CabalSpecVersion -> FilePath -> GBuildMode -> IO BuildSources
gbuildSources Verbosity
verbosity CabalSpecVersion
specVer FilePath
tmpDir GBuildMode
bm =
case GBuildMode
bm of
GBuildExe Executable
exe -> Executable -> IO BuildSources
exeSources Executable
exe
GReplExe [FilePath]
_ Executable
exe -> Executable -> IO BuildSources
exeSources Executable
exe
GBuildFLib ForeignLib
flib -> BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
GReplFLib [FilePath]
_ ForeignLib
flib -> BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
where
exeSources :: Executable -> IO BuildSources
exeSources :: Executable -> IO BuildSources
exeSources exe :: Executable
exe@Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo, modulePath :: Executable -> FilePath
modulePath = FilePath
modPath} = do
FilePath
main <- Verbosity -> [FilePath] -> FilePath -> IO FilePath
findFileEx Verbosity
verbosity (FilePath
tmpDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bnfo) FilePath
modPath
let mainModName :: ModuleName
mainModName = ModuleName -> Maybe ModuleName -> ModuleName
forall a. a -> Maybe a -> a
fromMaybe ModuleName
ModuleName.main (Maybe ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Executable -> Maybe ModuleName
exeMainModuleName Executable
exe
otherModNames :: [ModuleName]
otherModNames = Executable -> [ModuleName]
exeModules Executable
exe
if FilePath -> Bool
isHaskell FilePath
main
then
if CabalSpecVersion
specVer CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0 Bool -> Bool -> Bool
&& (ModuleName
mainModName ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
otherModNames)
then do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Enabling workaround for Main module '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
mainModName
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' listed in 'other-modules' illegally!"
BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
cSourcesFiles :: [FilePath]
cSourcesFiles = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [FilePath]
cxxSourceFiles = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [FilePath]
inputSourceFiles = [FilePath
main],
inputSourceModules :: [ModuleName]
inputSourceModules = (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
mainModName) ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Executable -> [ModuleName]
exeModules Executable
exe
}
else BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
cSourcesFiles :: [FilePath]
cSourcesFiles = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [FilePath]
cxxSourceFiles = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [FilePath]
inputSourceFiles = [FilePath
main],
inputSourceModules :: [ModuleName]
inputSourceModules = Executable -> [ModuleName]
exeModules Executable
exe
}
else let ([FilePath]
csf, [FilePath]
cxxsf)
| FilePath -> Bool
isCxx FilePath
main = ( BuildInfo -> [FilePath]
cSources BuildInfo
bnfo, FilePath
main FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo)
| Bool
otherwise = (FilePath
main FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
cSources BuildInfo
bnfo, BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo)
in BuildSources -> IO BuildSources
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
cSourcesFiles :: [FilePath]
cSourcesFiles = [FilePath]
csf,
cxxSourceFiles :: [FilePath]
cxxSourceFiles = [FilePath]
cxxsf,
inputSourceFiles :: [FilePath]
inputSourceFiles = [],
inputSourceModules :: [ModuleName]
inputSourceModules = Executable -> [ModuleName]
exeModules Executable
exe
}
flibSources :: ForeignLib -> BuildSources
flibSources :: ForeignLib -> BuildSources
flibSources flib :: ForeignLib
flib@ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
bnfo} =
BuildSources :: [FilePath]
-> [FilePath] -> [FilePath] -> [ModuleName] -> BuildSources
BuildSources {
cSourcesFiles :: [FilePath]
cSourcesFiles = BuildInfo -> [FilePath]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [FilePath]
cxxSourceFiles = BuildInfo -> [FilePath]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [FilePath]
inputSourceFiles = [],
inputSourceModules :: [ModuleName]
inputSourceModules = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
}
isHaskell :: FilePath -> Bool
isHaskell :: FilePath -> Bool
isHaskell FilePath
fp = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".hs", FilePath
".lhs"]
isCxx :: FilePath -> Bool
isCxx :: FilePath -> Bool
isCxx FilePath
fp = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
fp) [FilePath
".cpp", FilePath
".cxx", FilePath
".c++"]
gbuild :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> GBuildMode -> ComponentLocalBuildInfo -> IO ()
gbuild :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
verbosity Flag (Maybe Int)
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi GBuildMode
bm ComponentLocalBuildInfo
clbi = do
(ConfiguredProgram
ghcjsProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let replFlags :: [FilePath]
replFlags = case GBuildMode
bm of
GReplExe [FilePath]
flags Executable
_ -> [FilePath]
flags
GReplFLib [FilePath]
flags ForeignLib
_ -> [FilePath]
flags
GBuildExe{} -> [FilePath]
forall a. Monoid a => a
mempty
GBuildFLib{} -> [FilePath]
forall a. Monoid a => a
mempty
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
runGhcProg :: GhcOptions -> IO ()
runGhcProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
let (BuildInfo
bnfo, Bool
threaded) = case GBuildMode
bm of
GBuildFLib ForeignLib
_ -> BuildInfo -> (BuildInfo, Bool)
popThreadedFlag (GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm)
GBuildMode
_ -> (GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm, Bool
False)
let targetName :: FilePath
targetName = LocalBuildInfo -> GBuildMode -> FilePath
gbuildTargetName LocalBuildInfo
lbi GBuildMode
bm
let targetDir :: FilePath
targetDir = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi FilePath -> FilePath -> FilePath
</> (GBuildMode -> FilePath
gbuildName GBuildMode
bm)
let tmpDir :: FilePath
tmpDir = FilePath
targetDir FilePath -> FilePath -> FilePath
</> (GBuildMode -> FilePath
gbuildName GBuildMode
bm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-tmp")
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
targetDir
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
tmpDir
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
| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm = Flag FilePath
forall a. Monoid a => a
mempty
| 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 (GBuildMode -> FilePath
gbuildName GBuildMode
bm)
| Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty
NubListR FilePath
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
BuildSources
buildSources <- Verbosity
-> CabalSpecVersion -> FilePath -> GBuildMode -> IO BuildSources
gbuildSources Verbosity
verbosity (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
tmpDir GBuildMode
bm
let cSrcs :: [FilePath]
cSrcs = BuildSources -> [FilePath]
cSourcesFiles BuildSources
buildSources
cxxSrcs :: [FilePath]
cxxSrcs = BuildSources -> [FilePath]
cxxSourceFiles BuildSources
buildSources
inputFiles :: [FilePath]
inputFiles = BuildSources -> [FilePath]
inputSourceFiles BuildSources
buildSources
inputModules :: [ModuleName]
inputModules = BuildSources -> [ModuleName]
inputSourceModules BuildSources
buildSources
isGhcDynamic :: Bool
isGhcDynamic = Compiler -> Bool
isDynamic Compiler
comp
dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
cObjs :: [FilePath]
cObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cSrcs
cxxObjs :: [FilePath]
cxxObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cxxSrcs
needDynamic :: Bool
needDynamic = LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic LocalBuildInfo
lbi GBuildMode
bm
needProfiling :: Bool
needProfiling = LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi
baseOpts :: GhcOptions
baseOpts = (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir)
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]
inputFiles,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR [ModuleName]
inputModules
}
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 = 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,
ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
False
(LocalBuildInfo -> ProfDetailLevel
withProfExeDetail LocalBuildInfo
lbi),
ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_hi",
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"p_o",
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
bnfo,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
}
dynOpts :: GhcOptions
dynOpts = 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,
ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
dynTooOpts :: GhcOptions
dynTooOpts = 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,
ghcOptDynHiSuffix :: Flag FilePath
ghcOptDynHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_hi",
ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"dyn_o",
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
bnfo,
ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = BuildInfo -> [FilePath]
extraLibs BuildInfo
bnfo,
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
bnfo,
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
bnfo,
ghcOptLinkFrameworkDirs :: NubListR FilePath
ghcOptLinkFrameworkDirs = [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.extraFrameworkDirs BuildInfo
bnfo,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR
[FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cObjs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
cxxObjs]
}
dynLinkerOpts :: GhcOptions
dynLinkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptRPaths :: NubListR FilePath
ghcOptRPaths = NubListR FilePath
rpaths
}
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
}
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 | Bool
needProfiling = GhcOptions
profOpts
| Bool
needDynamic = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
compileOpts :: GhcOptions
compileOpts | Bool
useDynToo = GhcOptions
dynTooOpts
| Bool
otherwise = GhcOptions
commonOpts
withStaticExe :: Bool
withStaticExe = Bool -> Bool
not Bool
needProfiling Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
needDynamic
doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
bnfo
useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&& Bool
isGhcDynamic
Bool -> Bool -> Bool
&& Bool
doingTH Bool -> Bool -> Bool
&& Bool
withStaticExe
Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo)
compileTHOpts :: GhcOptions
compileTHOpts | Bool
isGhcDynamic = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
compileForTH :: Bool
compileForTH
| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm = Bool
False
| Bool
useDynToo = Bool
False
| Bool
isGhcDynamic = Bool
doingTH Bool -> Bool -> Bool
&& (Bool
needProfiling Bool -> Bool -> Bool
|| Bool
withStaticExe)
| Bool
otherwise = Bool
doingTH Bool -> Bool -> Bool
&& (Bool
needProfiling Bool -> Bool -> Bool
|| Bool
needDynamic)
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 ()
runGhcProg 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 (([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
inputFiles Bool -> Bool -> Bool
&& [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
inputModules)
Bool -> Bool -> Bool
|| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg 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 }
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cxxSrcs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C++ Sources..."
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let baseCxxOpts :: GhcOptions
baseCxxOpts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCxxGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir FilePath
filename
vanillaCxxOpts :: GhcOptions
vanillaCxxOpts = if Bool
isGhcDynamic
then GhcOptions
baseCxxOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
else GhcOptions
baseCxxOpts
profCxxOpts :: GhcOptions
profCxxOpts = GhcOptions
vanillaCxxOpts 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
}
sharedCxxOpts :: GhcOptions
sharedCxxOpts = GhcOptions
vanillaCxxOpts 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
}
opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCxxOpts
| Bool
needDynamic = GhcOptions
sharedCxxOpts
| Bool
otherwise = GhcOptions
vanillaCxxOpts
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
Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
opts
| FilePath
filename <- [FilePath]
cxxSrcs ]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cSrcs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Building C Sources..."
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let baseCcOpts :: GhcOptions
baseCcOpts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi FilePath
tmpDir FilePath
filename
vanillaCcOpts :: GhcOptions
vanillaCcOpts = if Bool
isGhcDynamic
then GhcOptions
baseCcOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True }
else GhcOptions
baseCcOpts
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
}
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
}
opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCcOpts
| Bool
needDynamic = GhcOptions
sharedCcOpts
| Bool
otherwise = GhcOptions
vanillaCcOpts
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
Bool
needsRecomp <- FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
opts
| FilePath
filename <- [FilePath]
cSrcs ]
case GBuildMode
bm of
GReplExe [FilePath]
_ Executable
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
GReplFLib [FilePath]
_ ForeignLib
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
GBuildExe Executable
_ -> do
let 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 ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
inputFiles)
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi then GhcOptions
dynLinkerOpts else GhcOptions
forall a. Monoid a => a
mempty)
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
let target :: FilePath
target = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
targetName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
7]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
e <- FilePath -> IO Bool
doesFileExist FilePath
target
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (FilePath -> IO ()
removeFile FilePath
target)
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
target }
GBuildFLib ForeignLib
flib -> do
let rtsInfo :: RtsInfo
rtsInfo = LocalBuildInfo -> RtsInfo
extractRtsInfo LocalBuildInfo
lbi
rtsOptLinkLibs :: [FilePath]
rtsOptLinkLibs = [
if Bool
needDynamic
then if Bool
threaded
then DynamicRtsInfo -> FilePath
dynRtsThreadedLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else DynamicRtsInfo -> FilePath
dynRtsVanillaLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else if Bool
threaded
then StaticRtsInfo -> FilePath
statRtsThreadedLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
else StaticRtsInfo -> FilePath
statRtsVanillaLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
]
linkOpts :: GhcOptions
linkOpts = case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
ForeignLibType
ForeignLibNativeShared ->
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
dynLinkerOpts
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
True,
ghcOptShared :: Flag Bool
ghcOptShared = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = [FilePath]
rtsOptLinkLibs,
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
$ RtsInfo -> [FilePath]
rtsLibPaths RtsInfo
rtsInfo,
ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptLinkModDefFiles :: NubListR FilePath
ghcOptLinkModDefFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ GBuildMode -> [FilePath]
gbuildModDefFiles GBuildMode
bm
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` LocalBuildInfo -> GhcOptions -> GhcOptions
forall a. Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi GhcOptions
forall a. Monoid a => a
mempty {
ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions = [FilePath
"-Wl,--no-as-needed"]
, ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = [FilePath
"ffi"]
}
ForeignLibType
ForeignLibNativeStatic ->
FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"static libraries not yet implemented"
ForeignLibType
ForeignLibTypeUnknown ->
FilePath -> GhcOptions
forall a. FilePath -> a
cabalBug FilePath
"unknown foreign lib type"
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity FilePath
"Linking..."
let buildName :: FilePath
buildName = LocalBuildInfo -> ForeignLib -> FilePath
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
buildName) }
FilePath -> FilePath -> IO ()
renameFile (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
buildName) (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
targetName)
ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround :: LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi a
a =
case LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi of
Platform Arch
_ OS
Linux -> a
a
Platform
_otherwise -> a
forall a. Monoid a => a
mempty
data DynamicRtsInfo = DynamicRtsInfo {
DynamicRtsInfo -> FilePath
dynRtsVanillaLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsDebugLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsEventlogLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedDebugLib :: FilePath
, DynamicRtsInfo -> FilePath
dynRtsThreadedEventlogLib :: FilePath
}
data StaticRtsInfo = StaticRtsInfo {
StaticRtsInfo -> FilePath
statRtsVanillaLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsDebugLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsEventlogLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedDebugLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedEventlogLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsProfilingLib :: FilePath
, StaticRtsInfo -> FilePath
statRtsThreadedProfilingLib :: FilePath
}
data RtsInfo = RtsInfo {
RtsInfo -> DynamicRtsInfo
rtsDynamicInfo :: DynamicRtsInfo
, RtsInfo -> StaticRtsInfo
rtsStaticInfo :: StaticRtsInfo
, RtsInfo -> [FilePath]
rtsLibPaths :: [FilePath]
}
extractRtsInfo :: LocalBuildInfo -> RtsInfo
LocalBuildInfo
lbi =
case InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi) (FilePath -> PackageName
mkPackageName FilePath
"rts") of
[(Version
_, [InstalledPackageInfo
rts])] -> InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts
[(Version, [InstalledPackageInfo])]
_otherwise -> FilePath -> RtsInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"No (or multiple) ghc rts package is registered"
where
aux :: InstalledPackageInfo -> RtsInfo
aux :: InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts = RtsInfo :: DynamicRtsInfo -> StaticRtsInfo -> [FilePath] -> RtsInfo
RtsInfo {
rtsDynamicInfo :: DynamicRtsInfo
rtsDynamicInfo = DynamicRtsInfo :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> DynamicRtsInfo
DynamicRtsInfo {
dynRtsVanillaLib :: FilePath
dynRtsVanillaLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts"
, dynRtsThreadedLib :: FilePath
dynRtsThreadedLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr"
, dynRtsDebugLib :: FilePath
dynRtsDebugLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_debug"
, dynRtsEventlogLib :: FilePath
dynRtsEventlogLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_l"
, dynRtsThreadedDebugLib :: FilePath
dynRtsThreadedDebugLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_debug"
, dynRtsThreadedEventlogLib :: FilePath
dynRtsThreadedEventlogLib = FilePath -> FilePath
withGhcVersion FilePath
"HSrts_thr_l"
}
, rtsStaticInfo :: StaticRtsInfo
rtsStaticInfo = StaticRtsInfo :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> StaticRtsInfo
StaticRtsInfo {
statRtsVanillaLib :: FilePath
statRtsVanillaLib = FilePath
"HSrts"
, statRtsThreadedLib :: FilePath
statRtsThreadedLib = FilePath
"HSrts_thr"
, statRtsDebugLib :: FilePath
statRtsDebugLib = FilePath
"HSrts_debug"
, statRtsEventlogLib :: FilePath
statRtsEventlogLib = FilePath
"HSrts_l"
, statRtsThreadedDebugLib :: FilePath
statRtsThreadedDebugLib = FilePath
"HSrts_thr_debug"
, statRtsThreadedEventlogLib :: FilePath
statRtsThreadedEventlogLib = FilePath
"HSrts_thr_l"
, statRtsProfilingLib :: FilePath
statRtsProfilingLib = FilePath
"HSrts_p"
, statRtsThreadedProfilingLib :: FilePath
statRtsThreadedProfilingLib = FilePath
"HSrts_thr_p"
}
, rtsLibPaths :: [FilePath]
rtsLibPaths = InstalledPackageInfo -> [FilePath]
InstalledPackageInfo.libraryDirs InstalledPackageInfo
rts
}
withGhcVersion :: FilePath -> FilePath
withGhcVersion = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
"-ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))))
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation FilePath
filename GhcOptions
opts = FilePath
filename FilePath -> FilePath -> IO Bool
`moreRecentFile` FilePath
oname
where oname :: FilePath
oname = FilePath -> GhcOptions -> FilePath
getObjectFileName FilePath
filename GhcOptions
opts
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName FilePath
filename GhcOptions
opts = FilePath
oname
where odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
oext :: FilePath
oext = FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"o" (GhcOptions -> Flag FilePath
ghcOptObjSuffix GhcOptions
opts)
oname :: FilePath
oname = FilePath
odir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
replaceExtension FilePath
filename FilePath
oext
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR FilePath)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi | OS -> Bool
supportRPaths OS
hostOS = do
[FilePath]
libraryPaths <- Bool
-> Bool
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO [FilePath]
depLibraryPaths Bool
False (LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
let hostPref :: FilePath
hostPref = case OS
hostOS of
OS
OSX -> FilePath
"@loader_path"
OS
_ -> FilePath
"$ORIGIN"
relPath :: FilePath -> FilePath
relPath FilePath
p = if FilePath -> Bool
isRelative FilePath
p then FilePath
hostPref FilePath -> FilePath -> FilePath
</> FilePath
p else FilePath
p
rpaths :: NubListR FilePath
rpaths = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
relPath [FilePath]
libraryPaths)
NubListR FilePath -> IO (NubListR FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR FilePath
rpaths
where
(Platform Arch
_ OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId (Compiler -> CompilerId)
-> (LocalBuildInfo -> Compiler) -> LocalBuildInfo -> CompilerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler (LocalBuildInfo -> CompilerId) -> LocalBuildInfo -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi
supportRPaths :: OS -> Bool
supportRPaths OS
Linux = Bool
True
supportRPaths OS
Windows = Bool
False
supportRPaths OS
OSX = Bool
True
supportRPaths OS
FreeBSD =
case CompilerId
compid of
CompilerId CompilerFlavor
GHC Version
ver | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7,Int
10,Int
2] -> Bool
True
CompilerId
_ -> Bool
False
supportRPaths OS
OpenBSD = Bool
False
supportRPaths OS
NetBSD = Bool
False
supportRPaths OS
DragonFly = Bool
False
supportRPaths OS
Solaris = Bool
False
supportRPaths OS
AIX = Bool
False
supportRPaths OS
HPUX = Bool
False
supportRPaths OS
IRIX = Bool
False
supportRPaths OS
HaLVM = Bool
False
supportRPaths OS
IOS = Bool
False
supportRPaths OS
Android = Bool
False
supportRPaths OS
Ghcjs = Bool
False
supportRPaths OS
Hurd = Bool
False
supportRPaths (OtherOS FilePath
_) = Bool
False
getRPaths LocalBuildInfo
_ ComponentLocalBuildInfo
_ = NubListR FilePath -> IO (NubListR FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR FilePath
forall a. Monoid a => a
mempty
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag BuildInfo
bi =
( BuildInfo
bi { options :: PerCompilerFlavor [FilePath]
options = (FilePath -> Bool)
-> PerCompilerFlavor [FilePath] -> PerCompilerFlavor [FilePath]
filterHcOptions (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"-threaded") (BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
bi) }
, PerCompilerFlavor [FilePath] -> Bool
hasThreaded (BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
bi))
where
filterHcOptions :: (String -> Bool)
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
filterHcOptions :: (FilePath -> Bool)
-> PerCompilerFlavor [FilePath] -> PerCompilerFlavor [FilePath]
filterHcOptions FilePath -> Bool
p (PerCompilerFlavor [FilePath]
ghc [FilePath]
ghcjs) =
[FilePath] -> [FilePath] -> PerCompilerFlavor [FilePath]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
p [FilePath]
ghc) [FilePath]
ghcjs
hasThreaded :: PerCompilerFlavor [String] -> Bool
hasThreaded :: PerCompilerFlavor [FilePath] -> Bool
hasThreaded (PerCompilerFlavor [FilePath]
ghc [FilePath]
_) = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
"-threaded" [FilePath]
ghc
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
libAbiHash Verbosity
verbosity PackageDescription
_pkg_descr LocalBuildInfo
lbi Library
lib 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
vanillaArgs0 :: GhcOptions
vanillaArgs0 =
(Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi))
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]
exposedModules Library
lib
}
vanillaArgs :: GhcOptions
vanillaArgs =
GhcOptions
vanillaArgs0 { ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = [PackageDB
GlobalPackageDB]
, ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages = NubListR (OpenUnitId, ModuleRenaming)
forall a. Monoid a => a
mempty }
sharedArgs :: GhcOptions
sharedArgs = GhcOptions
vanillaArgs 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,
ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"js_dyn_hi",
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"js_dyn_o",
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi
}
profArgs :: GhcOptions
profArgs = 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,
ghcOptProfilingAuto :: Flag GhcProfAuto
ghcOptProfilingAuto = Bool -> ProfDetailLevel -> Flag GhcProfAuto
Internal.profDetailLevelFlag Bool
True
(LocalBuildInfo -> ProfDetailLevel
withProfLibDetail LocalBuildInfo
lbi),
ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"js_p_hi",
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
"js_p_o",
ghcOptExtra :: [FilePath]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
libBi
}
ghcArgs :: GhcOptions
ghcArgs
| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi = GhcOptions
vanillaArgs
| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi = GhcOptions
sharedArgs
| LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi = GhcOptions
profArgs
| Bool
otherwise = FilePath -> GhcOptions
forall a. HasCallStack => FilePath -> a
error FilePath
"libAbiHash: Can't find an enabled library way"
(ConfiguredProgram
ghcjsProg, ProgramDb
_) <- 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)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi 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
}
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
componentCcGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
componentCcGhcOptions Verbosity
verbosity LocalBuildInfo
lbi =
Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi
where
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe Verbosity
verbosity LocalBuildInfo
lbi FilePath
binDir FilePath
buildPref
(FilePath
progprefix, FilePath
progsuffix) PackageDescription
_pkg 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 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
$
[ FilePath
"--install-executable"
, FilePath
buildPref FilePath -> FilePath -> FilePath
</> FilePath
exeName' FilePath -> FilePath -> FilePath
</> FilePath
exeFileName
, FilePath
"-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
(Bool
True, Just ConfiguredProgram
strip) -> [FilePath
"-strip-program", ConfiguredProgram -> FilePath
programPath ConfiguredProgram
strip]
(Bool, Maybe ConfiguredProgram)
_ -> []
FilePath -> IO ()
installBinary (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fixedExeBaseName)
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib Verbosity
verbosity LocalBuildInfo
lbi FilePath
targetDir FilePath
builtDir PackageDescription
_pkg ForeignLib
flib =
Bool -> FilePath -> FilePath -> FilePath -> IO ()
forall p. p -> FilePath -> FilePath -> FilePath -> IO ()
install (ForeignLib -> Bool
foreignLibIsShared ForeignLib
flib)
FilePath
builtDir
FilePath
targetDir
(LocalBuildInfo -> ForeignLib -> FilePath
flibTargetName LocalBuildInfo
lbi ForeignLib
flib)
where
install :: p -> FilePath -> FilePath -> FilePath -> IO ()
install p
_isShared FilePath
srcDir FilePath
dstDir 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
targetDir
Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verbosity FilePath
src FilePath
dst
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
lbi FilePath
targetDir FilePath
dynlibTargetDir FilePath
_builtDir PackageDescription
_pkg Library
lib ComponentLocalBuildInfo
clbi = do
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"js_hi"
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"js_p_hi"
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles FilePath
"js_dyn_hi"
IO () -> IO ()
whenHasCode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir' FilePath
targetDir (FilePath -> FilePath
toJSLibName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
mkGenericStaticLibName (FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f))
| FilePath
l <- UnitId -> FilePath
getHSLibraryName (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(BuildInfo -> [FilePath]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib))
, FilePath
f <- FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
extraLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
]
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir' FilePath
targetDir (FilePath -> FilePath
toJSLibName FilePath
profileLibName)
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> FilePath -> IO ()
installShared FilePath
builtDir' FilePath
dynlibTargetDir
(FilePath -> FilePath
toJSLibName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Platform -> CompilerId -> FilePath -> FilePath
mkGenericSharedLibName Platform
platform CompilerId
compiler_id (FilePath
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f))
| FilePath
l <- UnitId -> FilePath
getHSLibraryName UnitId
uid FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib)
, FilePath
f <- FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
extraDynLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
]
where
builtDir' :: FilePath
builtDir' = LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
install :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
isShared Bool
isJS FilePath
srcDir FilePath
dstDir 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
copyModuleFiles :: FilePath -> IO ()
copyModuleFiles FilePath
ext =
Verbosity
-> [FilePath]
-> [FilePath]
-> [ModuleName]
-> IO [(FilePath, FilePath)]
findModuleFilesEx Verbosity
verbosity [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)
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
profileLibName :: FilePath
profileLibName = UnitId -> FilePath
mkProfLibName 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))
Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cxxSources (Library -> BuildInfo
libBuildInfo Library
lib))
Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
jsSources (Library -> BuildInfo
libBuildInfo Library
lib))
has_code :: Bool
has_code = Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
whenHasCode :: IO () -> IO ()
whenHasCode = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code
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 Bool -> Bool -> Bool
&& Bool
has_code)
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 Bool -> Bool -> Bool
&& Bool
has_code)
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts :: FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts FilePath
hiSuf FilePath
objSuf 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
}
isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty FilePath
"Support dynamic-too"
withExt :: FilePath -> String -> FilePath
withExt :: FilePath -> FilePath -> FilePath
withExt FilePath
fp FilePath
ext = FilePath
fp FilePath -> FilePath -> FilePath
<.> if FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
ext) then FilePath
ext else FilePath
""
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity FilePath
pgm =
FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion FilePath
"--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 FilePath
pgm =
FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion FilePath
"--numeric-ghcjs-version" FilePath -> FilePath
forall a. a -> a
id Verbosity
verbosity FilePath
pgm
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo :: ProgramDb -> HcPkgInfo
hcPkgInfo 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 [Int
7,Int
10]
ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.hcPkgInfo no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsPkgProgram ProgramDb
progdb
ver :: Version
ver = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Version
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.hcPkgInfo no ghcjs version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsPkgProg
registerPackage
:: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage :: Verbosity
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity ProgramDb
progdb [PackageDB]
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions =
HcPkgInfo
-> Verbosity
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
HcPkg.register (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity [PackageDB]
packageDbs
InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot Verbosity
verbosity LocalBuildInfo
lbi = PackageDB -> IO FilePath
pkgRoot'
where
pkgRoot' :: PackageDB -> IO FilePath
pkgRoot' PackageDB
GlobalPackageDB =
let ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.pkgRoot: no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
in (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
takeDirectory (Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg)
pkgRoot' PackageDB
UserPackageDB = do
FilePath
appDir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"ghcjs"
let ver :: Version
ver = Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
subdir :: FilePath
subdir = FilePath
System.Info.arch FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
System.Info.os
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ver
rootDir :: FilePath
rootDir = FilePath
appDir FilePath -> FilePath -> FilePath
</> FilePath
subdir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
rootDir
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
rootDir
pkgRoot' (SpecificPackageDB FilePath
fp) = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
takeDirectory FilePath
fp)
runCmd :: ProgramDb -> FilePath
-> (FilePath, FilePath, [String])
runCmd :: ProgramDb -> FilePath -> (FilePath, FilePath, [FilePath])
runCmd ProgramDb
progdb 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]
++ [FilePath
"--run"]
)
where
script :: FilePath
script = FilePath
exe FilePath -> FilePath -> FilePath
<.> FilePath
"jsexe" FilePath -> FilePath -> FilePath
</> FilePath
"all" FilePath -> FilePath -> FilePath
<.> FilePath
"js"
ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ConfiguredProgram
forall a. HasCallStack => FilePath -> a
error FilePath
"GHCJS.runCmd: no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb