{-# 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 Distribution.Utils.Path
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 String
-> Maybe String
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
verbosity Maybe String
hcPath Maybe String
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]))
(String -> Maybe String -> ProgramDb -> ProgramDb
userMaybeSpecifyPath String
"ghcjs" Maybe String
hcPath ProgramDb
conf0)
Just Version
ghcjsGhcVersion <- Verbosity -> String -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity (ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Version
ghcjsGhcVersion forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
8,Int
8]) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Unknown/unsupported 'ghc' version detected "
forall a. [a] -> [a] -> [a]
++ String
"(Cabal " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
cabalVersion forall a. [a] -> [a] -> [a]
++ String
" supports 'ghc' version < 8.8): "
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg forall a. [a] -> [a] -> [a]
++ String
" is based on GHC version " forall a. [a] -> [a] -> [a]
++
forall a. Pretty a => a -> String
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 (String, [String]))
programFindLocation = ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessGhcjsPkgFromGhcjsPath ConfiguredProgram
ghcjsProg
}
VersionRange
anyVersion (String -> Maybe String -> ProgramDb -> ProgramDb
userMaybeSpecifyPath String
"ghcjs-pkg" Maybe String
hcPkgPath ProgramDb
progdb1)
Just Version
ghcjsPkgGhcjsVersion <- Verbosity -> String -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion
Verbosity
verbosity (ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsPkgProg)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsVersion forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgGhcjsVersion) forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Version mismatch between ghcjs and ghcjs-pkg: "
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg forall a. [a] -> [a] -> [a]
++ String
" is version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ghcjsVersion forall a. [a] -> [a] -> [a]
++ String
" "
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsPkgProg forall a. [a] -> [a] -> [a]
++ String
" is version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ghcjsPkgGhcjsVersion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsGhcVersion forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgVersion) forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
String
"Version mismatch between ghcjs and ghcjs-pkg: "
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg
forall a. [a] -> [a] -> [a]
++ String
" was built with GHC version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ghcjsGhcVersion forall a. [a] -> [a] -> [a]
++ String
" "
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsPkgProg
forall a. [a] -> [a] -> [a]
++ String
" was built with GHC version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ghcjsPkgVersion
let hsc2hsProgram' :: Program
hsc2hsProgram' = Program
hsc2hsProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation =
ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHsc2hsFromGhcjsPath ConfiguredProgram
ghcjsProg
}
haddockProgram' :: Program
haddockProgram' = Program
haddockProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation =
ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHaddockFromGhcjsPath ConfiguredProgram
ghcjsProg
}
hpcProgram' :: Program
hpcProgram' = Program
hpcProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation = ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHpcFromGhcjsPath ConfiguredProgram
ghcjsProg
}
progdb3 :: ProgramDb
progdb3 = Program -> ProgramDb -> ProgramDb
addKnownProgram Program
haddockProgram' forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hsc2hsProgram' forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hpcProgram' forall a b. (a -> b) -> a -> b
$
ProgramDb
progdb2
[(Language, String)]
languages <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(Language, String)]
Internal.getLanguages Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
[(Extension, Maybe String)]
extensions <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> IO [(Extension, Maybe String)]
Internal.getExtensions Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
[(String, String)]
ghcjsInfo <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(String, String)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
let ghcInfoMap :: Map String String
ghcInfoMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
ghcjsInfo
let comp :: Compiler
comp = Compiler {
compilerId :: CompilerId
compilerId = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHCJS Version
ghcjsVersion,
compilerAbiTag :: AbiTag
compilerAbiTag = String -> AbiTag
AbiTag forall a b. (a -> b) -> a -> b
$
String
"ghc" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"_" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers forall a b. (a -> b) -> a -> b
$ Version
ghcjsGhcVersion),
compilerCompat :: [CompilerId]
compilerCompat = [CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHC Version
ghcjsGhcVersion],
compilerLanguages :: [(Language, String)]
compilerLanguages = [(Language, String)]
languages,
compilerExtensions :: [(Extension, Maybe String)]
compilerExtensions = [(Extension, Maybe String)]
extensions,
compilerProperties :: Map String String
compilerProperties = Map String String
ghcInfoMap
}
compPlatform :: Maybe Platform
compPlatform = [(String, String)] -> Maybe Platform
Internal.targetPlatform [(String, String)]
ghcjsInfo
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 (String, [String]))
guessGhcjsPkgFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
guessToolFromGhcjsPath Program
ghcjsPkgProgram
guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHsc2hsFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
guessToolFromGhcjsPath Program
hsc2hsProgram
guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHaddockFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
guessToolFromGhcjsPath Program
haddockProgram
guessHpcFromGhcjsPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcjsPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
guessHpcFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
guessToolFromGhcjsPath Program
hpcProgram
guessToolFromGhcjsPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath :: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (String, [String]))
guessToolFromGhcjsPath Program
tool ConfiguredProgram
ghcjsProg Verbosity
verbosity ProgramSearchPath
searchpath
= do let toolname :: String
toolname = Program -> String
programName Program
tool
given_path :: String
given_path = ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg
given_dir :: String
given_dir = String -> String
takeDirectory String
given_path
String
real_path <- String -> IO String
canonicalizePath String
given_path
let real_dir :: String
real_dir = String -> String
takeDirectory String
real_path
versionSuffix :: String -> String
versionSuffix String
path = String -> String
takeVersionSuffix (String -> String
dropExeExtension String
path)
given_suf :: String
given_suf = String -> String
versionSuffix String
given_path
real_suf :: String
real_suf = String -> String
versionSuffix String
real_path
guessNormal :: String -> String
guessNormal String
dir = String
dir String -> String -> String
</> String
toolname String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessGhcjs :: String -> String
guessGhcjs String
dir = String
dir String -> String -> String
</> (String
toolname forall a. [a] -> [a] -> [a]
++ String
"-ghcjs")
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessGhcjsVersioned :: String -> String -> String
guessGhcjsVersioned String
dir String
suf = String
dir String -> String -> String
</> (String
toolname forall a. [a] -> [a] -> [a]
++ String
"-ghcjs" forall a. [a] -> [a] -> [a]
++ String
suf)
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessVersioned :: String -> String -> String
guessVersioned String
dir String
suf = String
dir String -> String -> String
</> (String
toolname forall a. [a] -> [a] -> [a]
++ String
suf)
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
mkGuesses :: String -> String -> [String]
mkGuesses String
dir String
suf | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
suf = [String -> String
guessGhcjs String
dir, String -> String
guessNormal String
dir]
| Bool
otherwise = [String -> String -> String
guessGhcjsVersioned String
dir String
suf,
String -> String -> String
guessVersioned String
dir String
suf,
String -> String
guessGhcjs String
dir,
String -> String
guessNormal String
dir]
guesses :: [String]
guesses = String -> String -> [String]
mkGuesses String
given_dir String
given_suf forall a. [a] -> [a] -> [a]
++
if String
real_path forall a. Eq a => a -> a -> Bool
== String
given_path
then []
else String -> String -> [String]
mkGuesses String
real_dir String
real_suf
Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"looking for tool " forall a. [a] -> [a] -> [a]
++ String
toolname
forall a. [a] -> [a] -> [a]
++ String
" near compiler in " forall a. [a] -> [a] -> [a]
++ String
given_dir
Verbosity -> String -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"candidate locations: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
guesses
[Bool]
exists <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO Bool
doesFileExist [String]
guesses
case [ String
file | (String
file, Bool
True) <- forall a b. [a] -> [b] -> [(a, b)]
zip [String]
guesses [Bool]
exists ] of
[] -> Program
-> Verbosity -> ProgramSearchPath -> IO (Maybe (String, [String]))
programFindLocation Program
tool Verbosity
verbosity ProgramSearchPath
searchpath
(String
fp:[String]
_) -> do Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"found " forall a. [a] -> [a] -> [a]
++ String
toolname forall a. [a] -> [a] -> [a]
++ String
" in " forall a. [a] -> [a] -> [a]
++ String
fp
let lookedAt :: [String]
lookedAt = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(String
_file, Bool
exist) -> Bool -> Bool
not Bool
exist)
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [String]
guesses [Bool]
exists
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (String
fp, [String]
lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix :: String -> String
takeVersionSuffix = 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 forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo Verbosity
verbosity ConfiguredProgram
ghcjsProg = Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(String, String)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
where
version :: Version
version = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.getGhcInfo: no 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
String
topDir <- Verbosity -> ConfiguredProgram -> IO String
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg
let indices :: [InstalledPackageIndex]
indices = [ [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList (forall a b. (a -> b) -> [a] -> [b]
map (String -> InstalledPackageInfo -> InstalledPackageInfo
Internal.substTopDir String
topDir) [InstalledPackageInfo]
pkgs)
| (PackageDB
_, [InstalledPackageInfo]
pkgs) <- [(PackageDB, [InstalledPackageInfo])]
pkgss ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall a. Monoid a => [a] -> a
mconcat [InstalledPackageIndex]
indices)
where
ghcjsProg :: ConfiguredProgram
ghcjsProg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.toPackageIndex no ghcjs program") 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 String
getLibDir Verbosity
verbosity LocalBuildInfo
lbi =
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> Program -> ProgramDb -> [String] -> IO String
getDbProgramOutput Verbosity
verbosity Program
ghcjsProgram
(LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) [String
"--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' :: Verbosity -> ConfiguredProgram -> IO String
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg =
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcjsProg [String
"--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO String
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcProg =
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcProg [String
"--print-global-package-db"]
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
getUserPackageDB :: Verbosity -> ConfiguredProgram -> Platform -> IO String
getUserPackageDB Verbosity
_verbosity ConfiguredProgram
ghcjsProg Platform
platform = do
String
appdir <- String -> IO String
getAppUserDataDirectory String
"ghcjs"
forall (m :: * -> *) a. Monad m => a -> m a
return (String
appdir String -> String -> String
</> String
platformAndVersion String -> String -> String
</> String
packageConfFileName)
where
platformAndVersion :: String
platformAndVersion = Platform -> Version -> String
Internal.ghcPlatformAndVersionString
Platform
platform Version
ghcjsVersion
packageConfFileName :: String
packageConfFileName = String
"package.conf.d"
ghcjsVersion :: Version
ghcjsVersion = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.getUserPackageDB: no version") forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity =
Verbosity -> String -> String -> IO ()
Internal.checkPackageDbEnvVar Verbosity
verbosity String
"GHCJS" String
"GHCJS_PACKAGE_PATH"
checkPackageDbStack :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStack :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
_ (PackageDB
GlobalPackageDB:[PackageDB]
rest)
| PackageDB
GlobalPackageDB forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
rest
| PackageDB
GlobalPackageDB forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest =
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"With current ghc versions the global package db is always used "
forall a. [a] -> [a] -> [a]
++ String
"and must be listed first. This ghc limitation may be lifted in "
forall a. [a] -> [a] -> [a]
++ String
"future, see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"
checkPackageDbStack Verbosity
verbosity [PackageDB]
_ =
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"If the global package db is specified, it must be "
forall a. [a] -> [a] -> [a]
++ String
"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 =
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
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 [String]
getInstalledPackagesMonitorFiles Verbosity
verbosity Platform
platform ProgramDb
progdb =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PackageDB -> IO String
getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath :: PackageDB -> IO String
getPackageDBPath PackageDB
GlobalPackageDB =
String -> IO String
selectMonitorFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> IO String
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg
getPackageDBPath PackageDB
UserPackageDB =
String -> IO String
selectMonitorFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Verbosity -> ConfiguredProgram -> Platform -> IO String
getUserPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg Platform
platform
getPackageDBPath (SpecificPackageDB String
path) = String -> IO String
selectMonitorFile String
path
selectMonitorFile :: String -> IO String
selectMonitorFile String
path = do
Bool
isFileStyle <- String -> IO Bool
doesFileExist String
path
if Bool
isFileStyle then forall (m :: * -> *) a. Monad m => a -> m a
return String
path
else forall (m :: * -> *) a. Monad m => a -> m a
return (String
path String -> String -> String
</> String
"package.cache")
ghcjsProg :: ConfiguredProgram
ghcjsProg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.toPackageIndex no ghcjs program") forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
toJSLibName :: String -> String
toJSLibName :: String -> String
toJSLibName String
lib
| String -> String
takeExtension String
lib forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".dll",String
".dylib",String
".so"]
= String -> String -> String
replaceExtension String
lib String
"js_so"
| String -> String
takeExtension String
lib forall a. Eq a => a -> a -> Bool
== String
".a" = String -> String -> String
replaceExtension String
lib String
"js_a"
| Bool
otherwise = String
lib String -> String -> String
<.> String
"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 [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib forall a. Maybe a
Nothing
replLib :: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
replLib :: [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = Maybe [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
buildOrReplLib :: Maybe [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
buildOrReplLib :: Maybe [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe [String]
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 :: String
libTargetDir = LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
whenVanillaLib :: Bool -> f () -> f ()
whenVanillaLib Bool
forceVanilla =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceVanilla Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
whenProfLib :: IO () -> IO ()
whenProfLib = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
whenSharedLib :: Bool -> f () -> f ()
whenSharedLib Bool
forceShared =
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 =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceStatic Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withStaticLib LocalBuildInfo
lbi)
forRepl :: Bool
forRepl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
True) Maybe [String]
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 :: String
pkg_name = forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr)
distPref :: String
distPref = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag String
configDistPref forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
hpcdir :: Way -> Flag String
hpcdir Way
way
| Bool
forRepl = forall a. Monoid a => a
mempty
| Bool
isCoverageEnabled = forall a. a -> Flag a
toFlag forall a b. (a -> b) -> a -> b
$ String -> Way -> String -> String
Hpc.mixDir String
distPref Way
way String
pkg_name
| Bool
otherwise = forall a. Monoid a => a
mempty
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
libTargetDir
let cLikeFiles :: [String]
cLikeFiles = forall a. NubListR a -> [a]
fromNubListR forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [String]
cSources BuildInfo
libBi) forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [String]
cxxSources BuildInfo
libBi)
jsSrcs :: [String]
jsSrcs = BuildInfo -> [String]
jsSources BuildInfo
libBi
cObjs :: [String]
cObjs = forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
cLikeFiles
baseOpts :: GhcOptions
baseOpts = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi String
libTargetDir
linkJsLibOpts :: GhcOptions
linkJsLibOpts = forall a. Monoid a => a
mempty {
ghcOptExtra :: [String]
ghcOptExtra =
[ String
"-link-js-lib" , UnitId -> String
getHSLibraryName UnitId
uid
, String
"-js-lib-outputdir", String
libTargetDir ] forall a. [a] -> [a] -> [a]
++
[String]
jsSrcs
}
vanillaOptsNoJsLib :: GhcOptions
vanillaOptsNoJsLib = GhcOptions
baseOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Vanilla
}
vanillaOpts :: GhcOptions
vanillaOpts = GhcOptions
vanillaOptsNoJsLib forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkJsLibOpts
profOpts :: GhcOptions
profOpts = String -> String -> GhcOptions -> GhcOptions
adjustExts String
"p_hi" String
"p_o" GhcOptions
vanillaOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = 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 :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Prof
}
sharedOpts :: GhcOptions
sharedOpts = String -> String -> GhcOptions -> GhcOptions
adjustExts String
"dyn_hi" String
"dyn_o" GhcOptions
vanillaOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Dyn
}
vanillaSharedOpts :: GhcOptions
vanillaSharedOpts = GhcOptions
vanillaOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
ghcOptDynHiSuffix :: Flag String
ghcOptDynHiSuffix = forall a. a -> Flag a
toFlag String
"js_dyn_hi",
ghcOptDynObjSuffix :: Flag String
ghcOptDynObjSuffix = forall a. a -> Flag a
toFlag String
"js_dyn_o",
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Dyn
}
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
forRepl Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
jsSrcs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cObjs) forall a b. (a -> b) -> a -> b
$
do let vanilla :: IO ()
vanilla = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
forceVanillaLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaOpts)
shared :: IO ()
shared = 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
&&
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [String]
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 String
hpcdir Way
Hpc.Dyn, Way -> Flag String
hpcdir Way
Hpc.Vanilla) of
(Cabal.Flag String
dynDir, Cabal.Flag String
vanillaDir) ->
Verbosity -> String -> String -> IO ()
copyDirectoryRecursive Verbosity
verbosity String
dynDir String
vanillaDir
(Flag String, Flag String)
_ -> 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)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl forall a b. (a -> b) -> a -> b
$ do
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Linking..."
let cSharedObjs :: [String]
cSharedObjs = forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` (String
"dyn_" forall a. [a] -> [a] -> [a]
++ String
objExtension))
(BuildInfo -> [String]
cSources BuildInfo
libBi forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cxxSources BuildInfo
libBi)
compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
sharedLibFilePath :: String
sharedLibFilePath = String
libTargetDir String -> String -> String
</> Platform -> CompilerId -> UnitId -> String
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
staticLibFilePath :: String
staticLibFilePath = String
libTargetDir String -> String -> String
</> Platform -> CompilerId -> UnitId -> String
mkStaticLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
let stubObjs :: [a]
stubObjs = []
stubSharedObjs :: [a]
stubSharedObjs = []
[String]
hObjs <- GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> Bool
-> IO [String]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
String
libTargetDir String
objExtension Bool
True
[String]
hSharedObjs <-
if LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi
then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> Bool
-> IO [String]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
String
libTargetDir (String
"dyn_" forall a. [a] -> [a] -> [a]
++ String
objExtension) Bool
False
else forall (m :: * -> *) a. Monad m => a -> m a
return []
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
hObjs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cObjs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a. [a]
stubObjs) forall a b. (a -> b) -> a -> b
$ do
NubListR String
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR String)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
let staticObjectFiles :: [String]
staticObjectFiles =
[String]
hObjs
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
libTargetDir String -> String -> String
</>) [String]
cObjs
forall a. [a] -> [a] -> [a]
++ forall a. [a]
stubObjs
dynamicObjectFiles :: [String]
dynamicObjectFiles =
[String]
hSharedObjs
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (String
libTargetDir String -> String -> String
</>) [String]
cSharedObjs
forall a. [a] -> [a] -> [a]
++ forall a. [a]
stubSharedObjs
ghcSharedLinkArgs :: GhcOptions
ghcSharedLinkArgs =
forall a. Monoid a => a
mempty {
ghcOptShared :: Flag Bool
ghcOptShared = forall a. a -> Flag a
toFlag Bool
True,
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptInputFiles :: NubListR String
ghcOptInputFiles = forall a. Ord a => [a] -> NubListR a
toNubListR [String]
dynamicObjectFiles,
ghcOptOutputFile :: Flag String
ghcOptOutputFile = forall a. a -> Flag a
toFlag String
sharedLibFilePath,
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = forall a. a -> Flag a
toFlag Bool
True,
ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = forall a. a -> Flag a
toFlag Bool
True,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
ghcOptThisUnitId :: Flag String
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk }
-> forall a. a -> Flag a
toFlag String
pk
ComponentLocalBuildInfo
_ -> forall a. Monoid a => a
mempty,
ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then forall a. Monoid a => a
mempty
else forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> 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 = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi ,
ghcOptLinkLibs :: [String]
ghcOptLinkLibs = BuildInfo -> [String]
extraLibs BuildInfo
libBi,
ghcOptLinkLibPath :: NubListR String
ghcOptLinkLibPath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
extraLibDirs BuildInfo
libBi,
ghcOptLinkFrameworks :: NubListR String
ghcOptLinkFrameworks = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
PD.frameworks BuildInfo
libBi,
ghcOptLinkFrameworkDirs :: NubListR String
ghcOptLinkFrameworkDirs =
forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
PD.extraFrameworkDirs BuildInfo
libBi,
ghcOptRPaths :: NubListR String
ghcOptRPaths = NubListR String
rpaths
}
ghcStaticLinkArgs :: GhcOptions
ghcStaticLinkArgs =
forall a. Monoid a => a
mempty {
ghcOptStaticLib :: Flag Bool
ghcOptStaticLib = forall a. a -> Flag a
toFlag Bool
True,
ghcOptInputFiles :: NubListR String
ghcOptInputFiles = forall a. Ord a => [a] -> NubListR a
toNubListR [String]
staticObjectFiles,
ghcOptOutputFile :: Flag String
ghcOptOutputFile = forall a. a -> Flag a
toFlag String
staticLibFilePath,
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcStaticOptions CompilerFlavor
GHC BuildInfo
libBi,
ghcOptHideAllPackages :: Flag Bool
ghcOptHideAllPackages = forall a. a -> Flag a
toFlag Bool
True,
ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = forall a. a -> Flag a
toFlag Bool
True,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
ghcOptThisUnitId :: Flag String
ghcOptThisUnitId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk }
-> forall a. a -> Flag a
toFlag String
pk
ComponentLocalBuildInfo
_ -> forall a. Monoid a => a
mempty,
ghcOptThisComponentId :: Flag ComponentId
ghcOptThisComponentId = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then forall a. Monoid a => a
mempty
else forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> 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 = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi ,
ghcOptLinkLibs :: [String]
ghcOptLinkLibs = BuildInfo -> [String]
extraLibs BuildInfo
libBi,
ghcOptLinkLibPath :: NubListR String
ghcOptLinkLibPath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
extraLibDirs BuildInfo
libBi
}
Verbosity -> String -> IO ()
info Verbosity
verbosity (forall a. Show a => a -> String
show (GhcOptions -> NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages GhcOptions
ghcSharedLinkArgs))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
False forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcjsProg GhcOptions
ghcSharedLinkArgs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenStaticLib Bool
False 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 = forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = 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 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 :: [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib [String]
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ForeignLib -> GBuildMode
GReplFLib [String]
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 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 :: [String]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe [String]
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Executable -> GBuildMode
GReplExe [String]
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 [String]
_ Executable
exe) = Executable -> BuildInfo
buildInfo Executable
exe
gbuildInfo (GBuildFLib ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
gbuildInfo (GReplFLib [String]
_ ForeignLib
flib) = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
gbuildName :: GBuildMode -> String
gbuildName :: GBuildMode -> String
gbuildName (GBuildExe Executable
exe) = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GReplExe [String]
_ Executable
exe) = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GBuildFLib ForeignLib
flib) = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildName (GReplFLib [String]
_ ForeignLib
flib) = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName LocalBuildInfo
lbi (GBuildExe Executable
exe) = Platform -> Executable -> String
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GReplExe [String]
_ Executable
exe) = Platform -> Executable -> String
exeTargetName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) Executable
exe
gbuildTargetName LocalBuildInfo
lbi (GBuildFLib ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> String
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
gbuildTargetName LocalBuildInfo
lbi (GReplFLib [String]
_ ForeignLib
flib) = LocalBuildInfo -> ForeignLib -> String
flibTargetName LocalBuildInfo
lbi ForeignLib
flib
exeTargetName :: Platform -> Executable -> String
exeTargetName :: Platform -> Executable -> String
exeTargetName Platform
platform Executable
exe = UnqualComponentName -> String
unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe) String -> String -> String
`withExt` Platform -> String
exeExtension Platform
platform
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName LocalBuildInfo
lbi ForeignLib
flib =
case (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) of
(OS
Windows, ForeignLibType
ForeignLibNativeShared) -> String
nm String -> String -> String
<.> String
"dll"
(OS
Windows, ForeignLibType
ForeignLibNativeStatic) -> String
nm String -> String -> String
<.> String
"lib"
(OS
Linux, ForeignLibType
ForeignLibNativeShared) -> String
"lib" forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> String
versionedExt
(OS
_other, ForeignLibType
ForeignLibNativeShared) -> String
"lib" forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> Platform -> String
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_other, ForeignLibType
ForeignLibNativeStatic) -> String
"lib" forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> Platform -> String
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_any, ForeignLibType
ForeignLibTypeUnknown) -> forall a. String -> a
cabalBug String
"unknown foreign lib type"
where
nm :: String
nm :: String
nm = UnqualComponentName -> String
unUnqualComponentName 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 :: String
versionedExt =
let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
(<.>) String
"so" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int]
nums)
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
| (OS
os, ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib) forall a. Eq a => a -> a -> Bool
==
(OS
Linux, ForeignLibType
ForeignLibNativeShared)
= let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in String
"lib" forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
(<.>) String
"so" (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall a. Int -> [a] -> [a]
take Int
1 [Int]
nums))
| Bool
otherwise = LocalBuildInfo -> ForeignLib -> String
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 :: String
nm = UnqualComponentName -> String
unUnqualComponentName 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 [String]
_ Executable
_) = Bool
True
gbuildIsRepl (GBuildFLib ForeignLib
_) = Bool
False
gbuildIsRepl (GReplFLib [String]
_ 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 [String]
_ Executable
_ -> LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
GBuildFLib ForeignLib
flib -> ForeignLib -> Bool
withDynFLib ForeignLib
flib
GReplFLib [String]
_ 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib
ForeignLibType
ForeignLibNativeStatic ->
Bool
False
ForeignLibType
ForeignLibTypeUnknown ->
forall a. String -> a
cabalBug String
"unknown foreign lib type"
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles :: GBuildMode -> [String]
gbuildModDefFiles (GBuildExe Executable
_) = []
gbuildModDefFiles (GReplExe [String]
_ Executable
_) = []
gbuildModDefFiles (GBuildFLib ForeignLib
flib) = ForeignLib -> [String]
foreignLibModDefFile ForeignLib
flib
gbuildModDefFiles (GReplFLib [String]
_ ForeignLib
flib) = ForeignLib -> [String]
foreignLibModDefFile ForeignLib
flib
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo} =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe ModuleName
decodeMainIsArg forall a b. (a -> b) -> a -> b
$ [String] -> [String]
findIsMainArgs [String]
ghcopts
where
ghcopts :: [String]
ghcopts = CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHC BuildInfo
bnfo
findIsMainArgs :: [String] -> [String]
findIsMainArgs [] = []
findIsMainArgs (String
"-main-is":String
arg:[String]
rest) = String
arg forall a. a -> [a] -> [a]
: [String] -> [String]
findIsMainArgs [String]
rest
findIsMainArgs (String
_:[String]
rest) = [String] -> [String]
findIsMainArgs [String]
rest
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg String
arg
| String -> (Char -> Bool) -> Bool
headOf String
main_fn Char -> Bool
isLower
= forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
ModuleName.fromString String
main_mod)
| String -> (Char -> Bool) -> Bool
headOf String
arg Char -> Bool
isUpper
= forall a. a -> Maybe a
Just (forall a. IsString a => String -> a
ModuleName.fromString String
arg)
| Bool
otherwise
= forall a. Maybe a
Nothing
where
headOf :: String -> (Char -> Bool) -> Bool
headOf :: String -> (Char -> Bool) -> Bool
headOf String
str Char -> Bool
pred' = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' (forall a. [a] -> Maybe a
safeHead String
str)
(String
main_mod, String
main_fn) = String -> (Char -> Bool) -> (String, String)
splitLongestPrefix String
arg (forall a. Eq a => a -> a -> Bool
== Char
'.')
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
splitLongestPrefix String
str Char -> Bool
pred'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r_pre = (String
str, [])
| Bool
otherwise = (forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
safeTail String
r_pre), forall a. [a] -> [a]
reverse String
r_suf)
where (String
r_suf, String
r_pre) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' (forall a. [a] -> [a]
reverse String
str)
data BuildSources = BuildSources {
BuildSources -> [String]
cSourcesFiles :: [FilePath],
BuildSources -> [String]
cxxSourceFiles :: [FilePath],
BuildSources -> [String]
inputSourceFiles :: [FilePath],
BuildSources -> [ModuleName]
inputSourceModules :: [ModuleName]
}
gbuildSources :: Verbosity
-> CabalSpecVersion
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources :: Verbosity
-> CabalSpecVersion -> String -> GBuildMode -> IO BuildSources
gbuildSources Verbosity
verbosity CabalSpecVersion
specVer String
tmpDir GBuildMode
bm =
case GBuildMode
bm of
GBuildExe Executable
exe -> Executable -> IO BuildSources
exeSources Executable
exe
GReplExe [String]
_ Executable
exe -> Executable -> IO BuildSources
exeSources Executable
exe
GBuildFLib ForeignLib
flib -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
GReplFLib [String]
_ ForeignLib
flib -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> String
modulePath = String
modPath} = do
String
main <- Verbosity -> [String] -> String -> IO String
findFileEx Verbosity
verbosity (String
tmpDir forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bnfo)) String
modPath
let mainModName :: ModuleName
mainModName = forall a. a -> Maybe a -> a
fromMaybe ModuleName
ModuleName.main forall a b. (a -> b) -> a -> b
$ Executable -> Maybe ModuleName
exeMainModuleName Executable
exe
otherModNames :: [ModuleName]
otherModNames = Executable -> [ModuleName]
exeModules Executable
exe
if String -> Bool
isHaskell String
main
then
if CabalSpecVersion
specVer forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0 Bool -> Bool -> Bool
&& (ModuleName
mainModName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
otherModNames)
then do
Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Enabling workaround for Main module '"
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow ModuleName
mainModName
forall a. [a] -> [a] -> [a]
++ String
"' listed in 'other-modules' illegally!"
forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources {
cSourcesFiles :: [String]
cSourcesFiles = BuildInfo -> [String]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [String]
cxxSourceFiles = BuildInfo -> [String]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [String]
inputSourceFiles = [String
main],
inputSourceModules :: [ModuleName]
inputSourceModules = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= ModuleName
mainModName) forall a b. (a -> b) -> a -> b
$ Executable -> [ModuleName]
exeModules Executable
exe
}
else forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources {
cSourcesFiles :: [String]
cSourcesFiles = BuildInfo -> [String]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [String]
cxxSourceFiles = BuildInfo -> [String]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [String]
inputSourceFiles = [String
main],
inputSourceModules :: [ModuleName]
inputSourceModules = Executable -> [ModuleName]
exeModules Executable
exe
}
else let ([String]
csf, [String]
cxxsf)
| String -> Bool
isCxx String
main = ( BuildInfo -> [String]
cSources BuildInfo
bnfo, String
main forall a. a -> [a] -> [a]
: BuildInfo -> [String]
cxxSources BuildInfo
bnfo)
| Bool
otherwise = (String
main forall a. a -> [a] -> [a]
: BuildInfo -> [String]
cSources BuildInfo
bnfo, BuildInfo -> [String]
cxxSources BuildInfo
bnfo)
in forall (m :: * -> *) a. Monad m => a -> m a
return BuildSources {
cSourcesFiles :: [String]
cSourcesFiles = [String]
csf,
cxxSourceFiles :: [String]
cxxSourceFiles = [String]
cxxsf,
inputSourceFiles :: [String]
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 {
cSourcesFiles :: [String]
cSourcesFiles = BuildInfo -> [String]
cSources BuildInfo
bnfo,
cxxSourceFiles :: [String]
cxxSourceFiles = BuildInfo -> [String]
cxxSources BuildInfo
bnfo,
inputSourceFiles :: [String]
inputSourceFiles = [],
inputSourceModules :: [ModuleName]
inputSourceModules = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
}
isHaskell :: FilePath -> Bool
isHaskell :: String -> Bool
isHaskell String
fp = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
takeExtension String
fp) [String
".hs", String
".lhs"]
isCxx :: FilePath -> Bool
isCxx :: String -> Bool
isCxx String
fp = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
takeExtension String
fp) [String
".cpp", String
".cxx", String
".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 :: [String]
replFlags = case GBuildMode
bm of
GReplExe [String]
flags Executable
_ -> [String]
flags
GReplFLib [String]
flags ForeignLib
_ -> [String]
flags
GBuildExe{} -> forall a. Monoid a => a
mempty
GBuildFLib{} -> 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 :: String
targetName = LocalBuildInfo -> GBuildMode -> String
gbuildTargetName LocalBuildInfo
lbi GBuildMode
bm
let targetDir :: String
targetDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> (GBuildMode -> String
gbuildName GBuildMode
bm)
let tmpDir :: String
tmpDir = String
targetDir String -> String -> String
</> (GBuildMode -> String
gbuildName GBuildMode
bm forall a. [a] -> [a] -> [a]
++ String
"-tmp")
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
targetDir
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
tmpDir
let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
distPref :: String
distPref = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag String
configDistPref forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
hpcdir :: Way -> Flag String
hpcdir Way
way
| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm = forall a. Monoid a => a
mempty
| Bool
isCoverageEnabled = forall a. a -> Flag a
toFlag forall a b. (a -> b) -> a -> b
$ String -> Way -> String -> String
Hpc.mixDir String
distPref Way
way (GBuildMode -> String
gbuildName GBuildMode
bm)
| Bool
otherwise = forall a. Monoid a => a
mempty
NubListR String
rpaths <- LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR String)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
BuildSources
buildSources <- Verbosity
-> CabalSpecVersion -> String -> GBuildMode -> IO BuildSources
gbuildSources Verbosity
verbosity (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) String
tmpDir GBuildMode
bm
let cSrcs :: [String]
cSrcs = BuildSources -> [String]
cSourcesFiles BuildSources
buildSources
cxxSrcs :: [String]
cxxSrcs = BuildSources -> [String]
cxxSourceFiles BuildSources
buildSources
inputFiles :: [String]
inputFiles = BuildSources -> [String]
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 :: [String]
cObjs = forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
cSrcs
cxxObjs :: [String]
cxxObjs = forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
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
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi String
tmpDir)
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
ghcOptInputFiles :: NubListR String
ghcOptInputFiles = forall a. Ord a => [a] -> NubListR a
toNubListR [String]
inputFiles,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = forall a. Ord a => [a] -> NubListR a
toNubListR [ModuleName]
inputModules
}
staticOpts :: GhcOptions
staticOpts = GhcOptions
baseOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticOnly,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Vanilla
}
profOpts :: GhcOptions
profOpts = GhcOptions
baseOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = 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 String
ghcOptHiSuffix = forall a. a -> Flag a
toFlag String
"p_hi",
ghcOptObjSuffix :: Flag String
ghcOptObjSuffix = forall a. a -> Flag a
toFlag String
"p_o",
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcProfOptions CompilerFlavor
GHC BuildInfo
bnfo,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Prof
}
dynOpts :: GhcOptions
dynOpts = GhcOptions
baseOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptHiSuffix :: Flag String
ghcOptHiSuffix = forall a. a -> Flag a
toFlag String
"dyn_hi",
ghcOptObjSuffix :: Flag String
ghcOptObjSuffix = forall a. a -> Flag a
toFlag String
"dyn_o",
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo,
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Dyn
}
dynTooOpts :: GhcOptions
dynTooOpts = GhcOptions
staticOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
ghcOptDynHiSuffix :: Flag String
ghcOptDynHiSuffix = forall a. a -> Flag a
toFlag String
"dyn_hi",
ghcOptDynObjSuffix :: Flag String
ghcOptDynObjSuffix = forall a. a -> Flag a
toFlag String
"dyn_o",
ghcOptHPCDir :: Flag String
ghcOptHPCDir = Way -> Flag String
hpcdir Way
Hpc.Dyn
}
linkerOpts :: GhcOptions
linkerOpts = forall a. Monoid a => a
mempty {
ghcOptLinkOptions :: [String]
ghcOptLinkOptions = BuildInfo -> [String]
PD.ldOptions BuildInfo
bnfo,
ghcOptLinkLibs :: [String]
ghcOptLinkLibs = BuildInfo -> [String]
extraLibs BuildInfo
bnfo,
ghcOptLinkLibPath :: NubListR String
ghcOptLinkLibPath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ BuildInfo -> [String]
extraLibDirs BuildInfo
bnfo,
ghcOptLinkFrameworks :: NubListR String
ghcOptLinkFrameworks = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
BuildInfo -> [String]
PD.frameworks BuildInfo
bnfo,
ghcOptLinkFrameworkDirs :: NubListR String
ghcOptLinkFrameworkDirs = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$
BuildInfo -> [String]
PD.extraFrameworkDirs BuildInfo
bnfo,
ghcOptInputFiles :: NubListR String
ghcOptInputFiles = forall a. Ord a => [a] -> NubListR a
toNubListR
[String
tmpDir String -> String -> String
</> String
x | String
x <- [String]
cObjs forall a. [a] -> [a] -> [a]
++ [String]
cxxObjs]
}
dynLinkerOpts :: GhcOptions
dynLinkerOpts = forall a. Monoid a => a
mempty {
ghcOptRPaths :: NubListR String
ghcOptRPaths = NubListR String
rpaths
}
replOpts :: GhcOptions
replOpts = GhcOptions
baseOpts {
ghcOptExtra :: [String]
ghcOptExtra = [String] -> [String]
Internal.filterGhciFlags
(GhcOptions -> [String]
ghcOptExtra GhcOptions
baseOpts)
forall a. Semigroup a => a -> a -> a
<> [String]
replFlags
}
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = 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
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [String]
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)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
compileForTH forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
compileTHOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink = forall a. a -> Flag a
toFlag Bool
True
, ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
inputFiles Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
inputModules)
Bool -> Bool -> Bool
|| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm) forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
compileOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink = forall a. a -> Flag a
toFlag Bool
True
, ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cxxSrcs) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Building C++ Sources..."
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let baseCxxOpts :: GhcOptions
baseCxxOpts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
Internal.componentCxxGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi String
tmpDir String
filename
vanillaCxxOpts :: GhcOptions
vanillaCxxOpts = if Bool
isGhcDynamic
then GhcOptions
baseCxxOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True }
else GhcOptions
baseCxxOpts
profCxxOpts :: GhcOptions
profCxxOpts = GhcOptions
vanillaCxxOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = forall a. a -> Flag a
toFlag Bool
True
}
sharedCxxOpts :: GhcOptions
sharedCxxOpts = GhcOptions
vanillaCxxOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly
}
opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCxxOpts
| Bool
needDynamic = GhcOptions
sharedCxxOpts
| Bool
otherwise = GhcOptions
vanillaCxxOpts
odir :: String
odir = forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
odir
Bool
needsRecomp <- String -> GhcOptions -> IO Bool
checkNeedsRecompilation String
filename GhcOptions
opts
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
opts
| String
filename <- [String]
cxxSrcs ]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cSrcs) forall a b. (a -> b) -> a -> b
$ do
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Building C Sources..."
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let baseCcOpts :: GhcOptions
baseCcOpts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi String
tmpDir String
filename
vanillaCcOpts :: GhcOptions
vanillaCcOpts = if Bool
isGhcDynamic
then GhcOptions
baseCcOpts { ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True }
else GhcOptions
baseCcOpts
profCcOpts :: GhcOptions
profCcOpts = GhcOptions
vanillaCcOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = forall a. a -> Flag a
toFlag Bool
True
}
sharedCcOpts :: GhcOptions
sharedCcOpts = GhcOptions
vanillaCcOpts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly
}
opts :: GhcOptions
opts | Bool
needProfiling = GhcOptions
profCcOpts
| Bool
needDynamic = GhcOptions
sharedCcOpts
| Bool
otherwise = GhcOptions
vanillaCcOpts
odir :: String
odir = forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
odir
Bool
needsRecomp <- String -> GhcOptions -> IO Bool
checkNeedsRecompilation String
filename GhcOptions
opts
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needsRecomp forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcProg GhcOptions
opts
| String
filename <- [String]
cSrcs ]
case GBuildMode
bm of
GReplExe [String]
_ Executable
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
GReplFLib [String]
_ ForeignLib
_ -> GhcOptions -> IO ()
runGhcProg GhcOptions
replOpts
GBuildExe Executable
_ -> do
let linkOpts :: GhcOptions
linkOpts = GhcOptions
commonOpts
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain = forall a. a -> Flag a
toFlag (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
inputFiles)
}
forall a. Monoid a => a -> a -> a
`mappend` (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi then GhcOptions
dynLinkerOpts else forall a. Monoid a => a
mempty)
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Linking..."
let target :: String
target = String
targetDir String -> String -> String
</> String
targetName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Version
compilerVersion Compiler
comp forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
7]) forall a b. (a -> b) -> a -> b
$ do
Bool
e <- String -> IO Bool
doesFileExist String
target
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (String -> IO ()
removeFile String
target)
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag String
ghcOptOutputFile = forall a. a -> Flag a
toFlag String
target }
GBuildFLib ForeignLib
flib -> do
let rtsInfo :: RtsInfo
rtsInfo = LocalBuildInfo -> RtsInfo
extractRtsInfo LocalBuildInfo
lbi
rtsOptLinkLibs :: [String]
rtsOptLinkLibs = [
if Bool
needDynamic
then if Bool
threaded
then DynamicRtsInfo -> String
dynRtsThreadedLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else DynamicRtsInfo -> String
dynRtsVanillaLib (RtsInfo -> DynamicRtsInfo
rtsDynamicInfo RtsInfo
rtsInfo)
else if Bool
threaded
then StaticRtsInfo -> String
statRtsThreadedLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
else StaticRtsInfo -> String
statRtsVanillaLib (RtsInfo -> StaticRtsInfo
rtsStaticInfo RtsInfo
rtsInfo)
]
linkOpts :: GhcOptions
linkOpts = case ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib of
ForeignLibType
ForeignLibNativeShared ->
GhcOptions
commonOpts
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
dynLinkerOpts
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain = forall a. a -> Flag a
toFlag Bool
True,
ghcOptShared :: Flag Bool
ghcOptShared = forall a. a -> Flag a
toFlag Bool
True,
ghcOptLinkLibs :: [String]
ghcOptLinkLibs = [String]
rtsOptLinkLibs,
ghcOptLinkLibPath :: NubListR String
ghcOptLinkLibPath = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ RtsInfo -> [String]
rtsLibPaths RtsInfo
rtsInfo,
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptLinkModDefFiles :: NubListR String
ghcOptLinkModDefFiles = forall a. Ord a => [a] -> NubListR a
toNubListR forall a b. (a -> b) -> a -> b
$ GBuildMode -> [String]
gbuildModDefFiles GBuildMode
bm
}
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi forall a. Monoid a => a
mempty {
ghcOptLinkOptions :: [String]
ghcOptLinkOptions = [String
"-Wl,--no-as-needed"]
, ghcOptLinkLibs :: [String]
ghcOptLinkLibs = [String
"ffi"]
}
ForeignLibType
ForeignLibNativeStatic ->
forall a. String -> a
cabalBug String
"static libraries not yet implemented"
ForeignLibType
ForeignLibTypeUnknown ->
forall a. String -> a
cabalBug String
"unknown foreign lib type"
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Linking..."
let buildName :: String
buildName = LocalBuildInfo -> ForeignLib -> String
flibBuildName LocalBuildInfo
lbi ForeignLib
flib
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag String
ghcOptOutputFile = forall a. a -> Flag a
toFlag (String
targetDir String -> String -> String
</> String
buildName) }
String -> String -> IO ()
renameFile (String
targetDir String -> String -> String
</> String
buildName) (String
targetDir String -> String -> String
</> String
targetName)
ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround :: forall a. Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround LocalBuildInfo
lbi a
a =
case LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi of
Platform Arch
_ OS
Linux -> a
a
Platform
_otherwise -> forall a. Monoid a => a
mempty
data DynamicRtsInfo = DynamicRtsInfo {
DynamicRtsInfo -> String
dynRtsVanillaLib :: FilePath
, DynamicRtsInfo -> String
dynRtsThreadedLib :: FilePath
, DynamicRtsInfo -> String
dynRtsDebugLib :: FilePath
, DynamicRtsInfo -> String
dynRtsEventlogLib :: FilePath
, DynamicRtsInfo -> String
dynRtsThreadedDebugLib :: FilePath
, DynamicRtsInfo -> String
dynRtsThreadedEventlogLib :: FilePath
}
data StaticRtsInfo = StaticRtsInfo {
StaticRtsInfo -> String
statRtsVanillaLib :: FilePath
, StaticRtsInfo -> String
statRtsThreadedLib :: FilePath
, StaticRtsInfo -> String
statRtsDebugLib :: FilePath
, StaticRtsInfo -> String
statRtsEventlogLib :: FilePath
, StaticRtsInfo -> String
statRtsThreadedDebugLib :: FilePath
, StaticRtsInfo -> String
statRtsThreadedEventlogLib :: FilePath
, StaticRtsInfo -> String
statRtsProfilingLib :: FilePath
, StaticRtsInfo -> String
statRtsThreadedProfilingLib :: FilePath
}
data RtsInfo = RtsInfo {
RtsInfo -> DynamicRtsInfo
rtsDynamicInfo :: DynamicRtsInfo
, RtsInfo -> StaticRtsInfo
rtsStaticInfo :: StaticRtsInfo
, RtsInfo -> [String]
rtsLibPaths :: [FilePath]
}
extractRtsInfo :: LocalBuildInfo -> RtsInfo
LocalBuildInfo
lbi =
case forall a. PackageIndex a -> PackageName -> [(Version, [a])]
PackageIndex.lookupPackageName (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi) (String -> PackageName
mkPackageName String
"rts") of
[(Version
_, [InstalledPackageInfo
rts])] -> InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts
[(Version, [InstalledPackageInfo])]
_otherwise -> forall a. HasCallStack => String -> a
error String
"No (or multiple) ghc rts package is registered"
where
aux :: InstalledPackageInfo -> RtsInfo
aux :: InstalledPackageInfo -> RtsInfo
aux InstalledPackageInfo
rts = RtsInfo {
rtsDynamicInfo :: DynamicRtsInfo
rtsDynamicInfo = DynamicRtsInfo {
dynRtsVanillaLib :: String
dynRtsVanillaLib = String -> String
withGhcVersion String
"HSrts"
, dynRtsThreadedLib :: String
dynRtsThreadedLib = String -> String
withGhcVersion String
"HSrts_thr"
, dynRtsDebugLib :: String
dynRtsDebugLib = String -> String
withGhcVersion String
"HSrts_debug"
, dynRtsEventlogLib :: String
dynRtsEventlogLib = String -> String
withGhcVersion String
"HSrts_l"
, dynRtsThreadedDebugLib :: String
dynRtsThreadedDebugLib = String -> String
withGhcVersion String
"HSrts_thr_debug"
, dynRtsThreadedEventlogLib :: String
dynRtsThreadedEventlogLib = String -> String
withGhcVersion String
"HSrts_thr_l"
}
, rtsStaticInfo :: StaticRtsInfo
rtsStaticInfo = StaticRtsInfo {
statRtsVanillaLib :: String
statRtsVanillaLib = String
"HSrts"
, statRtsThreadedLib :: String
statRtsThreadedLib = String
"HSrts_thr"
, statRtsDebugLib :: String
statRtsDebugLib = String
"HSrts_debug"
, statRtsEventlogLib :: String
statRtsEventlogLib = String
"HSrts_l"
, statRtsThreadedDebugLib :: String
statRtsThreadedDebugLib = String
"HSrts_thr_debug"
, statRtsThreadedEventlogLib :: String
statRtsThreadedEventlogLib = String
"HSrts_thr_l"
, statRtsProfilingLib :: String
statRtsProfilingLib = String
"HSrts_p"
, statRtsThreadedProfilingLib :: String
statRtsThreadedProfilingLib = String
"HSrts_thr_p"
}
, rtsLibPaths :: [String]
rtsLibPaths = InstalledPackageInfo -> [String]
InstalledPackageInfo.libraryDirs InstalledPackageInfo
rts
}
withGhcVersion :: String -> String
withGhcVersion = (forall a. [a] -> [a] -> [a]
++ (String
"-ghc" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))))
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
checkNeedsRecompilation :: String -> GhcOptions -> IO Bool
checkNeedsRecompilation String
filename GhcOptions
opts = String
filename String -> String -> IO Bool
`moreRecentFile` String
oname
where oname :: String
oname = String -> GhcOptions -> String
getObjectFileName String
filename GhcOptions
opts
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName :: String -> GhcOptions -> String
getObjectFileName String
filename GhcOptions
opts = String
oname
where odir :: String
odir = forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
oext :: String
oext = forall a. a -> Flag a -> a
fromFlagOrDefault String
"o" (GhcOptions -> Flag String
ghcOptObjSuffix GhcOptions
opts)
oname :: String
oname = String
odir String -> String -> String
</> String -> String -> String
replaceExtension String
filename String
oext
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO (NubListR FilePath)
getRPaths :: LocalBuildInfo -> ComponentLocalBuildInfo -> IO (NubListR String)
getRPaths LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi | OS -> Bool
supportRPaths OS
hostOS = do
[String]
libraryPaths <- Bool
-> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
depLibraryPaths Bool
False (LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
let hostPref :: String
hostPref = case OS
hostOS of
OS
OSX -> String
"@loader_path"
OS
_ -> String
"$ORIGIN"
relPath :: String -> String
relPath String
p = if String -> Bool
isRelative String
p then String
hostPref String -> String -> String
</> String
p else String
p
rpaths :: NubListR String
rpaths = forall a. Ord a => [a] -> NubListR a
toNubListR (forall a b. (a -> b) -> [a] -> [b]
map String -> String
relPath [String]
libraryPaths)
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR String
rpaths
where
(Platform Arch
_ OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler 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 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 String
_) = Bool
False
getRPaths LocalBuildInfo
_ ComponentLocalBuildInfo
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag BuildInfo
bi =
( BuildInfo
bi { options :: PerCompilerFlavor [String]
options = (String -> Bool)
-> PerCompilerFlavor [String] -> PerCompilerFlavor [String]
filterHcOptions (forall a. Eq a => a -> a -> Bool
/= String
"-threaded") (BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi) }
, PerCompilerFlavor [String] -> Bool
hasThreaded (BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
bi))
where
filterHcOptions :: (String -> Bool)
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
filterHcOptions :: (String -> Bool)
-> PerCompilerFlavor [String] -> PerCompilerFlavor [String]
filterHcOptions String -> Bool
p (PerCompilerFlavor [String]
ghc [String]
ghcjs) =
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor (forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
p [String]
ghc) [String]
ghcjs
hasThreaded :: PerCompilerFlavor [String] -> Bool
hasThreaded :: PerCompilerFlavor [String] -> Bool
hasThreaded (PerCompilerFlavor [String]
ghc [String]
_) = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"-threaded" [String]
ghc
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO String
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
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi))
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = forall a. a -> Flag a
toFlag GhcMode
GhcModeAbiHash,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = forall a. Ord a => [a] -> NubListR a
toNubListR 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 = forall a. Monoid a => a
mempty }
sharedArgs :: GhcOptions
sharedArgs = GhcOptions
vanillaArgs forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptFPic :: Flag Bool
ghcOptFPic = forall a. a -> Flag a
toFlag Bool
True,
ghcOptHiSuffix :: Flag String
ghcOptHiSuffix = forall a. a -> Flag a
toFlag String
"js_dyn_hi",
ghcOptObjSuffix :: Flag String
ghcOptObjSuffix = forall a. a -> Flag a
toFlag String
"js_dyn_o",
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi
}
profArgs :: GhcOptions
profArgs = GhcOptions
vanillaArgs forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = 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 String
ghcOptHiSuffix = forall a. a -> Flag a
toFlag String
"js_p_hi",
ghcOptObjSuffix :: Flag String
ghcOptObjSuffix = forall a. a -> Flag a
toFlag String
"js_p_o",
ghcOptExtra :: [String]
ghcOptExtra = CompilerFlavor -> BuildInfo -> [String]
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 = forall a. HasCallStack => String -> a
error String
"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)
String
hash <- Verbosity -> ProgramInvocation -> IO String
getProgramInvocationOutput Verbosity
verbosity
(ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform GhcOptions
ghcArgs)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
hash)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir =
let opts :: GhcOptions
opts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
in GhcOptions
opts { ghcOptExtra :: [String]
ghcOptExtra = GhcOptions -> [String]
ghcOptExtra GhcOptions
opts forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [String]
hcOptions CompilerFlavor
GHCJS BuildInfo
bi
}
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
componentCcGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
componentCcGhcOptions Verbosity
verbosity LocalBuildInfo
lbi =
Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> 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
-> String
-> String
-> (String, String)
-> PackageDescription
-> Executable
-> IO ()
installExe Verbosity
verbosity LocalBuildInfo
lbi String
binDir String
buildPref
(String
progprefix, String
progsuffix) PackageDescription
_pkg Executable
exe = do
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
binDir
let exeName' :: String
exeName' = UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
exeFileName :: String
exeFileName = String
exeName'
fixedExeBaseName :: String
fixedExeBaseName = String
progprefix forall a. [a] -> [a] -> [a]
++ String
exeName' forall a. [a] -> [a] -> [a]
++ String
progsuffix
installBinary :: String -> IO ()
installBinary String
dest = do
Verbosity -> Program -> ProgramDb -> [String] -> IO ()
runDbProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) forall a b. (a -> b) -> a -> b
$
[ String
"--install-executable"
, String
buildPref String -> String -> String
</> String
exeName' String -> String -> String
</> String
exeFileName
, String
"-o", String
dest
] forall a. [a] -> [a] -> [a]
++
case (LocalBuildInfo -> Bool
stripExes LocalBuildInfo
lbi, Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
stripProgram forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) of
(Bool
True, Just ConfiguredProgram
strip) -> [String
"-strip-program", ConfiguredProgram -> String
programPath ConfiguredProgram
strip]
(Bool, Maybe ConfiguredProgram)
_ -> []
String -> IO ()
installBinary (String
binDir String -> String -> String
</> String
fixedExeBaseName)
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib :: Verbosity
-> LocalBuildInfo
-> String
-> String
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib Verbosity
verbosity LocalBuildInfo
lbi String
targetDir String
builtDir PackageDescription
_pkg ForeignLib
flib =
forall {p}. p -> String -> String -> String -> IO ()
install (ForeignLib -> Bool
foreignLibIsShared ForeignLib
flib)
String
builtDir
String
targetDir
(LocalBuildInfo -> ForeignLib -> String
flibTargetName LocalBuildInfo
lbi ForeignLib
flib)
where
install :: p -> String -> String -> String -> IO ()
install p
_isShared String
srcDir String
dstDir String
name = do
let src :: String
src = String
srcDir String -> String -> String
</> String
name
dst :: String
dst = String
dstDir String -> String -> String
</> String
name
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
targetDir
Verbosity -> String -> String -> IO ()
installOrdinaryFile Verbosity
verbosity String
src String
dst
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> String
-> String
-> String
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
lbi String
targetDir String
dynlibTargetDir String
_builtDir PackageDescription
_pkg Library
lib ComponentLocalBuildInfo
clbi = do
IO () -> IO ()
whenVanilla forall a b. (a -> b) -> a -> b
$ String -> IO ()
copyModuleFiles String
"js_hi"
IO () -> IO ()
whenProf forall a b. (a -> b) -> a -> b
$ String -> IO ()
copyModuleFiles String
"js_p_hi"
IO () -> IO ()
whenShared forall a b. (a -> b) -> a -> b
$ String -> IO ()
copyModuleFiles String
"js_dyn_hi"
IO () -> IO ()
whenHasCode forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenVanilla forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ String -> String -> String -> IO ()
installOrdinary String
builtDir' String
targetDir (String -> String
toJSLibName forall a b. (a -> b) -> a -> b
$ String -> String
mkGenericStaticLibName (String
l forall a. [a] -> [a] -> [a]
++ String
f))
| String
l <- UnitId -> String
getHSLibraryName (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)forall a. a -> [a] -> [a]
:(BuildInfo -> [String]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib))
, String
f <- String
""forall a. a -> [a] -> [a]
:BuildInfo -> [String]
extraLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
]
IO () -> IO ()
whenProf forall a b. (a -> b) -> a -> b
$ do
String -> String -> String -> IO ()
installOrdinary String
builtDir' String
targetDir (String -> String
toJSLibName String
profileLibName)
IO () -> IO ()
whenShared forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ String -> String -> String -> IO ()
installShared String
builtDir' String
dynlibTargetDir
(String -> String
toJSLibName forall a b. (a -> b) -> a -> b
$ Platform -> CompilerId -> String -> String
mkGenericSharedLibName Platform
platform CompilerId
compiler_id (String
l forall a. [a] -> [a] -> [a]
++ String
f))
| String
l <- UnitId -> String
getHSLibraryName UnitId
uid forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib)
, String
f <- String
""forall a. a -> [a] -> [a]
:BuildInfo -> [String]
extraDynLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
]
where
builtDir' :: String
builtDir' = LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
install :: Bool -> Bool -> String -> String -> String -> IO ()
install Bool
isShared Bool
isJS String
srcDir String
dstDir String
name = do
let src :: String
src = String
srcDir String -> String -> String
</> String
name
dst :: String
dst = String
dstDir String -> String -> String
</> String
name
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
dstDir
if Bool
isShared
then Verbosity -> String -> String -> IO ()
installExecutableFile Verbosity
verbosity String
src String
dst
else Verbosity -> String -> String -> IO ()
installOrdinaryFile Verbosity
verbosity String
src String
dst
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripLibs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isJS) forall a b. (a -> b) -> a -> b
$
Verbosity -> Platform -> ProgramDb -> String -> IO ()
Strip.stripLib Verbosity
verbosity
(LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) String
dst
installOrdinary :: String -> String -> String -> IO ()
installOrdinary = Bool -> Bool -> String -> String -> String -> IO ()
install Bool
False Bool
True
installShared :: String -> String -> String -> IO ()
installShared = Bool -> Bool -> String -> String -> String -> IO ()
install Bool
True Bool
True
copyModuleFiles :: String -> IO ()
copyModuleFiles String
ext =
Verbosity
-> [String] -> [String] -> [ModuleName] -> IO [(String, String)]
findModuleFilesEx Verbosity
verbosity [String
builtDir'] [String
ext] (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> String -> [(String, String)] -> IO ()
installOrdinaryFiles Verbosity
verbosity String
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 :: String
profileLibName = UnitId -> String
mkProfLibName UnitId
uid
hasLib :: Bool
hasLib = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cSources (Library -> BuildInfo
libBuildInfo Library
lib))
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cxxSources (Library -> BuildInfo
libBuildInfo Library
lib))
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
jsSources (Library -> BuildInfo
libBuildInfo Library
lib))
has_code :: Bool
has_code = Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
whenHasCode :: IO () -> IO ()
whenHasCode = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code
whenVanilla :: IO () -> IO ()
whenVanilla = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
whenProf :: IO () -> IO ()
whenProf = 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 = 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 :: String -> String -> GhcOptions -> GhcOptions
adjustExts String
hiSuf String
objSuf GhcOptions
opts =
GhcOptions
opts forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => a
mempty {
ghcOptHiSuffix :: Flag String
ghcOptHiSuffix = forall a. a -> Flag a
toFlag String
hiSuf,
ghcOptObjSuffix :: Flag String
ghcOptObjSuffix = forall a. a -> Flag a
toFlag String
objSuf
}
isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = String -> Compiler -> Bool
Internal.ghcLookupProperty String
"GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = String -> Compiler -> Bool
Internal.ghcLookupProperty String
"Support dynamic-too"
withExt :: FilePath -> String -> FilePath
withExt :: String -> String -> String
withExt String
fp String
ext = String
fp String -> String -> String
<.> if String -> String
takeExtension String
fp forall a. Eq a => a -> a -> Bool
/= (Char
'.'forall a. a -> [a] -> [a]
:String
ext) then String
ext else String
""
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion :: Verbosity -> String -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity String
pgm =
String
-> (String -> String) -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--numeric-ghc-version" forall a. a -> a
id Verbosity
verbosity String
pgm
findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion :: Verbosity -> String -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion Verbosity
verbosity String
pgm =
String
-> (String -> String) -> Verbosity -> String -> IO (Maybe Version)
findProgramVersion String
"--numeric-ghcjs-version" forall a. a -> a
id Verbosity
verbosity String
pgm
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo :: ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb = 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 forall a. Ord a => a -> a -> Bool
>= Version
v7_10
, nativeMultiInstance :: Bool
HcPkg.nativeMultiInstance = Version
ver 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 = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.hcPkgInfo no ghcjs program") forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsPkgProgram ProgramDb
progdb
ver :: Version
ver = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.hcPkgInfo no ghcjs 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 String
pkgRoot Verbosity
verbosity LocalBuildInfo
lbi = PackageDB -> IO String
pkgRoot'
where
pkgRoot' :: PackageDB -> IO String
pkgRoot' PackageDB
GlobalPackageDB =
let ghcjsProg :: ConfiguredProgram
ghcjsProg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.pkgRoot: no ghcjs program") forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
takeDirectory (Verbosity -> ConfiguredProgram -> IO String
getGlobalPackageDB Verbosity
verbosity ConfiguredProgram
ghcjsProg)
pkgRoot' PackageDB
UserPackageDB = do
String
appDir <- String -> IO String
getAppUserDataDirectory String
"ghcjs"
let ver :: Version
ver = Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
subdir :: String
subdir = String
System.Info.arch forall a. [a] -> [a] -> [a]
++ Char
'-'forall a. a -> [a] -> [a]
:String
System.Info.os
forall a. [a] -> [a] -> [a]
++ Char
'-'forall a. a -> [a] -> [a]
:forall a. Pretty a => a -> String
prettyShow Version
ver
rootDir :: String
rootDir = String
appDir String -> String -> String
</> String
subdir
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
rootDir
forall (m :: * -> *) a. Monad m => a -> m a
return String
rootDir
pkgRoot' (SpecificPackageDB String
fp) = forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
takeDirectory String
fp)
runCmd :: ProgramDb -> FilePath
-> (FilePath, FilePath, [String])
runCmd :: ProgramDb -> String -> (String, String, [String])
runCmd ProgramDb
progdb String
exe =
( String
script
, ConfiguredProgram -> String
programPath ConfiguredProgram
ghcjsProg
, ConfiguredProgram -> [String]
programDefaultArgs ConfiguredProgram
ghcjsProg forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
ghcjsProg forall a. [a] -> [a] -> [a]
++ [String
"--run"]
)
where
script :: String
script = String
exe String -> String -> String
<.> String
"jsexe" String -> String -> String
</> String
"all" String -> String -> String
<.> String
"js"
ghcjsProg :: ConfiguredProgram
ghcjsProg = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"GHCJS.runCmd: no ghcjs program") forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb