{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
module Distribution.Simple.GHCJS
( getGhcInfo
, configure
, getInstalledPackages
, getInstalledPackagesMonitorFiles
, getPackageDBContents
, buildLib
, buildFLib
, buildExe
, replLib
, replFLib
, replExe
, startInterpreter
, installLib
, installFLib
, installExe
, libAbiHash
, hcPkgInfo
, registerPackage
, componentGhcOptions
, Internal.componentCcGhcOptions
, getLibDir
, isDynamic
, getGlobalPackageDB
, pkgRoot
, runCmd
, Internal.GhcEnvironmentFileEntry (..)
, Internal.simpleGhcEnvironmentFile
, Internal.renderGhcEnvironmentFile
, Internal.writeGhcEnvironmentFile
, Internal.ghcPlatformAndVersionString
, readGhcEnvironmentFile
, parseGhcEnvironmentFile
, ParseErrorExc (..)
, getImplInfo
, GhcImplInfo (..)
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess.Types
import Distribution.Simple.Program
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Setup.Common
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.PackageName.Magic
import Distribution.Types.ParStrat
import Distribution.Utils.NubList
import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity)
import Distribution.Version
import Control.Monad (msum)
import Data.Char (isLower)
import qualified Data.Map as Map
import System.Directory
( canonicalizePath
, createDirectoryIfMissing
, doesFileExist
, getAppUserDataDirectory
, removeFile
, renameFile
)
import System.FilePath
( isRelative
, replaceExtension
, takeDirectory
, takeExtension
, (<.>)
, (</>)
)
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
(ghcjsProg, ghcjsVersion, 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 ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg)
unless (ghcjsGhcVersion < mkVersion [8, 8]) $
warn verbosity $
"Unknown/unsupported 'ghc' version detected "
++ "(Cabal "
++ prettyShow cabalVersion
++ " supports 'ghc' version < 8.8): "
++ programPath ghcjsProg
++ " is based on GHC version "
++ prettyShow ghcjsGhcVersion
let implInfo = Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo Version
ghcjsVersion Version
ghcjsGhcVersion
(ghcjsPkgProg, ghcjsPkgVersion, progdb2) <-
requireProgramVersion
verbosity
ghcjsPkgProgram
{ programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg
}
anyVersion
(userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath progdb1)
Just ghcjsPkgGhcjsVersion <-
findGhcjsPkgGhcjsVersion
verbosity
(programPath ghcjsPkgProg)
when (ghcjsVersion /= ghcjsPkgGhcjsVersion) $
dieWithException verbosity $
VersionMismatchJS
(programPath ghcjsProg)
ghcjsVersion
(programPath ghcjsPkgProg)
ghcjsPkgGhcjsVersion
when (ghcjsGhcVersion /= ghcjsPkgVersion) $
dieWithException verbosity $
VersionMismatchGHCJS (programPath ghcjsProg) ghcjsGhcVersion (programPath ghcjsPkgProg) ghcjsPkgVersion
let hsc2hsProgram' =
Program
hsc2hsProgram
{ programFindLocation =
guessHsc2hsFromGhcjsPath ghcjsProg
}
haddockProgram' =
Program
haddockProgram
{ programFindLocation =
guessHaddockFromGhcjsPath ghcjsProg
}
hpcProgram' =
Program
hpcProgram
{ programFindLocation = guessHpcFromGhcjsPath ghcjsProg
}
progdb3 =
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
haddockProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hsc2hsProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
Program -> ProgramDb -> ProgramDb
addKnownProgram Program
hpcProgram' (ProgramDb -> ProgramDb) -> ProgramDb -> ProgramDb
forall a b. (a -> b) -> a -> b
$
ProgramDb
progdb2
languages <- Internal.getLanguages verbosity implInfo ghcjsProg
extensions <- Internal.getExtensions verbosity implInfo ghcjsProg
ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg
let ghcInfoMap = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
ghcjsInfo
let comp =
Compiler
{ compilerId :: CompilerId
compilerId = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHCJS Version
ghcjsVersion
, compilerAbiTag :: AbiTag
compilerAbiTag =
String -> AbiTag
AbiTag (String -> AbiTag) -> String -> AbiTag
forall a b. (a -> b) -> a -> b
$
String
"ghc" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String]) -> (Version -> [Int]) -> Version -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers (Version -> [String]) -> Version -> [String]
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 = [(String, String)] -> Maybe Platform
Internal.targetPlatform [(String, String)]
ghcjsInfo
return (comp, compPlatform, 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
real_path <- String -> IO String
canonicalizePath String
given_path
let real_dir = String -> String
takeDirectory String
real_path
versionSuffix String
path = String -> String
takeVersionSuffix (String -> String
dropExeExtension String
path)
given_suf = String -> String
versionSuffix String
given_path
real_suf = String -> String
versionSuffix String
real_path
guessNormal String
dir = String
dir String -> String -> String
</> String
toolname String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessGhcjs String
dir =
String
dir
String -> String -> String
</> (String
toolname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-ghcjs")
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessGhcjsVersioned String
dir String
suf =
String
dir
String -> String -> String
</> (String
toolname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-ghcjs" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf)
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
guessVersioned String
dir String
suf =
String
dir
String -> String -> String
</> (String
toolname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf)
String -> String -> String
<.> Platform -> String
exeExtension Platform
buildPlatform
mkGuesses String
dir String
suf
| String -> Bool
forall a. [a] -> Bool
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 -> String -> [String]
mkGuesses String
given_dir String
given_suf
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if String
real_path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
given_path
then []
else String -> String -> [String]
mkGuesses String
real_dir String
real_suf
info verbosity $
"looking for tool "
++ toolname
++ " near compiler in "
++ given_dir
debug verbosity $ "candidate locations: " ++ show guesses
exists <- traverse doesFileExist guesses
case [file | (file, True) <- zip guesses 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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
toolname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp
let lookedAt :: [String]
lookedAt =
((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst
([(String, Bool)] -> [String])
-> ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(String
_file, Bool
exist) -> Bool -> Bool
not Bool
exist)
([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [Bool] -> [(String, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
guesses [Bool]
exists
Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
fp, [String]
lookedAt))
where
takeVersionSuffix :: FilePath -> String
takeVersionSuffix :: String -> String
takeVersionSuffix = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEndLE Char -> Bool
isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar :: Char -> Bool
isSuffixChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(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 = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (String -> Version
forall a. HasCallStack => String -> a
error String
"GHCJS.getGhcInfo: no version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsProg
implInfo :: GhcImplInfo
implInfo = Version -> GhcImplInfo
ghcVersionImplInfo Version
version
getPackageDBContents
:: Verbosity
-> PackageDB
-> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents Verbosity
verbosity PackageDB
packagedb ProgramDb
progdb = do
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB
packagedb] ProgramDb
progdb
toPackageIndex verbosity pkgss 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
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb
index <- toPackageIndex verbosity pkgss progdb
return $! index
toPackageIndex
:: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb = do
topDir <- Verbosity -> ConfiguredProgram -> IO String
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg
let indices =
[ [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList ((InstalledPackageInfo -> InstalledPackageInfo)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map (String -> InstalledPackageInfo -> InstalledPackageInfo
Internal.substTopDir String
topDir) [InstalledPackageInfo]
pkgs)
| (PackageDB
_, [InstalledPackageInfo]
pkgs) <- [(PackageDB, [InstalledPackageInfo])]
pkgss
]
return $! (mconcat indices)
where
ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (String -> ConfiguredProgram
forall a. HasCallStack => String -> a
error String
"GHCJS.toPackageIndex no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO String
getLibDir Verbosity
verbosity LocalBuildInfo
lbi =
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace
(String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
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 =
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace
(String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
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 =
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace
(String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
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
appdir <- String -> IO String
getAppUserDataDirectory String
"ghcjs"
return (appdir </> platformAndVersion </> packageConfFileName)
where
platformAndVersion :: String
platformAndVersion =
Platform -> Version -> String
Internal.ghcPlatformAndVersionString
Platform
platform
Version
ghcjsVersion
packageConfFileName :: String
packageConfFileName = String
"package.conf.d"
ghcjsVersion :: Version
ghcjsVersion = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (String -> Version
forall a. HasCallStack => String -> a
error String
"GHCJS.getUserPackageDB: no version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity =
Verbosity -> 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 PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
rest
| PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest =
Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
GlobalPackageDBLimitation
checkPackageDbStack Verbosity
verbosity [PackageDB]
_ =
Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
GlobalPackageDBSpecifiedFirst
getInstalledPackages'
:: Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' :: Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb =
[IO (PackageDB, [InstalledPackageInfo])]
-> IO [(PackageDB, [InstalledPackageInfo])]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
[ do
pkgs <- HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
HcPkg.dump (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity PackageDB
packagedb
return (packagedb, 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 =
(PackageDB -> IO String) -> [PackageDB] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse PackageDB -> IO String
getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath :: PackageDB -> IO String
getPackageDBPath PackageDB
GlobalPackageDB =
String -> IO String
selectMonitorFile (String -> IO String) -> IO String -> IO String
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 (String -> IO String) -> IO String -> IO String
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
isFileStyle <- String -> IO Bool
doesFileExist String
path
if isFileStyle
then return path
else return (path </> "package.cache")
ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (String -> ConfiguredProgram
forall a. HasCallStack => String -> a
error String
"GHCJS.toPackageIndex no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
toJSLibName :: String -> String
toJSLibName :: String -> String
toJSLibName String
lib
| String -> String
takeExtension String
lib String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 String -> String -> Bool
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
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib :: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib = Maybe [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe [String]
forall a. Maybe a
Nothing
replLib
:: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib :: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = Maybe [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib (Maybe [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ())
-> ([String] -> Maybe [String])
-> [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe [String]
forall a. a -> Maybe a
Just
buildOrReplLib
:: Maybe [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib :: Maybe [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe [String]
mReplFlags Verbosity
verbosity Flag ParStrat
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 =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceVanilla Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
whenProfLib :: IO () -> IO ()
whenProfLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
whenSharedLib :: Bool -> f () -> f ()
whenSharedLib Bool
forceShared =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceShared Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
whenStaticLib :: Bool -> f () -> f ()
whenStaticLib Bool
forceStatic =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
forceStatic Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withStaticLib LocalBuildInfo
lbi)
forRepl :: Bool
forRepl = Bool -> ([String] -> Bool) -> Maybe [String] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> [String] -> Bool
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)
(ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let runGhcjsProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
let libBi = Library -> BuildInfo
libBuildInfo Library
lib
let isGhcjsDynamic = Compiler -> Bool
isDynamic Compiler
comp
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
libBi
forceVanillaLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isGhcjsDynamic
forceSharedLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool
isGhcjsDynamic
let isCoverageEnabled = LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi
hpcdir Way
way
| Bool
forRepl = Flag String
forall a. Monoid a => a
mempty
| Bool
isCoverageEnabled = String -> Flag String
forall a. a -> Flag a
toFlag (String -> Flag String) -> String -> Flag String
forall a b. (a -> b) -> a -> b
$ String -> Way -> String
Hpc.mixDir (String
libTargetDir String -> String -> String
</> String
extraCompilationArtifacts) Way
way
| Bool
otherwise = Flag String
forall a. Monoid a => a
mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
let cLikeFiles = NubListR String -> [String]
forall a. NubListR a -> [a]
fromNubListR (NubListR String -> [String]) -> NubListR String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [String]
cSources BuildInfo
libBi) NubListR String -> NubListR String -> NubListR String
forall a. Semigroup a => a -> a -> a
<> [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR (BuildInfo -> [String]
cxxSources BuildInfo
libBi)
jsSrcs = BuildInfo -> [String]
jsSources BuildInfo
libBi
cObjs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
cLikeFiles
baseOpts = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi String
libTargetDir
linkJsLibOpts =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptExtra =
[ "-link-js-lib"
, getHSLibraryName uid
, "-js-lib-outputdir"
, libTargetDir
]
++ jsSrcs
}
vanillaOptsNoJsLib =
GhcOptions
baseOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeMake
, ghcOptNumJobs = numJobs
, ghcOptInputModules = toNubListR $ allLibModules lib clbi
, ghcOptHPCDir = hpcdir Hpc.Vanilla
}
vanillaOpts = GhcOptions
vanillaOptsNoJsLib GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkJsLibOpts
profOpts =
String -> String -> GhcOptions -> GhcOptions
adjustExts String
"p_hi" String
"p_o" GhcOptions
vanillaOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
True
(withProfLibDetail lbi)
,
ghcOptExtra = hcProfOptions GHC libBi
, ghcOptHPCDir = hpcdir Hpc.Prof
}
sharedOpts =
String -> String -> GhcOptions -> GhcOptions
adjustExts String
"dyn_hi" String
"dyn_o" GhcOptions
vanillaOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptFPic = toFlag True
,
ghcOptExtra = hcSharedOptions GHC libBi
, ghcOptHPCDir = hpcdir Hpc.Dyn
}
vanillaSharedOpts =
GhcOptions
vanillaOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
, ghcOptDynHiSuffix = toFlag "js_dyn_hi"
, ghcOptDynObjSuffix = toFlag "js_dyn_o"
, ghcOptHPCDir = hpcdir Hpc.Dyn
}
unless (forRepl || null (allLibModules lib clbi) && null jsSrcs && null cObjs) $
do
let vanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
forceVanillaLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaOpts)
shared = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
sharedOpts)
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
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
libBi)
if not has_code
then vanilla
else
if useDynToo
then do
runGhcjsProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
(Flag String
dynDir, Flag String
vanillaDir) ->
Verbosity -> String -> String -> IO ()
copyDirectoryRecursive Verbosity
verbosity String
dynDir String
vanillaDir
(Flag String, Flag String)
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
if isGhcjsDynamic
then do shared; vanilla
else do vanilla; shared
whenProfLib (runGhcjsProg profOpts)
when has_code . when False . unless forRepl $ do
info verbosity "Linking..."
let cSharedObjs =
(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
(String -> String -> String
`replaceExtension` (String
"dyn_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
objExtension))
(BuildInfo -> [String]
cSources BuildInfo
libBi [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cxxSources BuildInfo
libBi)
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
sharedLibFilePath = String
libTargetDir String -> String -> String
</> Platform -> CompilerId -> UnitId -> String
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
staticLibFilePath = String
libTargetDir String -> String -> String
</> Platform -> CompilerId -> UnitId -> String
mkStaticLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
let stubObjs = []
stubSharedObjs = []
hObjs <-
Internal.getHaskellObjects
implInfo
lib
lbi
clbi
libTargetDir
objExtension
True
hSharedObjs <-
if withSharedLib lbi
then
Internal.getHaskellObjects
implInfo
lib
lbi
clbi
libTargetDir
("dyn_" ++ objExtension)
False
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- getRPaths lbi clbi
let staticObjectFiles =
[String]
hObjs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
libTargetDir String -> String -> String
</>) [String]
cObjs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
forall a. [a]
stubObjs
dynamicObjectFiles =
[String]
hSharedObjs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
libTargetDir String -> String -> String
</>) [String]
cSharedObjs
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
forall a. [a]
stubSharedObjs
ghcSharedLinkArgs =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptShared = toFlag True
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptInputFiles = toNubListR dynamicObjectFiles
, ghcOptOutputFile = toFlag sharedLibFilePath
, ghcOptExtra = hcSharedOptions GHC libBi
,
ghcOptHideAllPackages = toFlag True
, ghcOptNoAutoLinkPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo{componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk} ->
String -> Flag String
forall a. a -> Flag a
toFlag String
pk
ComponentLocalBuildInfo
_ -> Flag String
forall a. Monoid a => a
mempty
, ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} ->
if [(ModuleName, OpenModule)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then Flag ComponentId
forall a. Monoid a => a
mempty
else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty
, ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} ->
[(ModuleName, OpenModule)]
insts
ComponentLocalBuildInfo
_ -> []
, ghcOptPackages =
toNubListR $
Internal.mkGhcOptPackages mempty clbi
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi
, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
, ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
}
ghcStaticLinkArgs =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptStaticLib = toFlag True
, ghcOptInputFiles = toNubListR staticObjectFiles
, ghcOptOutputFile = toFlag staticLibFilePath
, ghcOptExtra = hcStaticOptions GHC libBi
, ghcOptHideAllPackages = toFlag True
, ghcOptNoAutoLinkPackages = toFlag True
, ghcOptPackageDBs = withPackageDB lbi
, ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo{componentCompatPackageKey :: ComponentLocalBuildInfo -> String
componentCompatPackageKey = String
pk} ->
String -> Flag String
forall a. a -> Flag a
toFlag String
pk
ComponentLocalBuildInfo
_ -> Flag String
forall a. Monoid a => a
mempty
, ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} ->
if [(ModuleName, OpenModule)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, OpenModule)]
insts
then Flag ComponentId
forall a. Monoid a => a
mempty
else ComponentId -> Flag ComponentId
forall a. a -> Flag a
toFlag (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
ComponentLocalBuildInfo
_ -> Flag ComponentId
forall a. Monoid a => a
mempty
, ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} ->
[(ModuleName, OpenModule)]
insts
ComponentLocalBuildInfo
_ -> []
, ghcOptPackages =
toNubListR $
Internal.mkGhcOptPackages mempty clbi
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
whenSharedLib False $
runGhcjsProg ghcSharedLinkArgs
whenStaticLib False $
runGhcjsProg ghcStaticLinkArgs
startInterpreter
:: Verbosity
-> ProgramDb
-> Compiler
-> Platform
-> PackageDBStack
-> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> [PackageDB] -> IO ()
startInterpreter Verbosity
verbosity ProgramDb
progdb Compiler
comp Platform
platform [PackageDB]
packageDBs = do
let replOpts :: GhcOptions
replOpts =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeInteractive
, ghcOptPackageDBs = packageDBs
}
Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
packageDBs
(ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram ProgramDb
progdb
runGHC verbosity ghcjsProg comp platform replOpts
buildFLib
:: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib :: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
buildFLib Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> GBuildMode
GBuildFLib
replFLib
:: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib :: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
replFLib [String]
replFlags Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi =
Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (ForeignLib -> GBuildMode)
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ForeignLib -> GBuildMode
GReplFLib [String]
replFlags
buildExe
:: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe :: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi = Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> GBuildMode
GBuildExe
replExe
:: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe :: [String]
-> Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe [String]
replFlags Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi =
Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
v Flag ParStrat
njobs PackageDescription
pkg LocalBuildInfo
lbi (GBuildMode -> ComponentLocalBuildInfo -> IO ())
-> (Executable -> GBuildMode)
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
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 (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GReplExe [String]
_ Executable
exe) = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
gbuildName (GBuildFLib ForeignLib
flib) = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib
gbuildName (GReplFLib [String]
_ ForeignLib
flib) = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
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" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> String
versionedExt
(OS
_other, ForeignLibType
ForeignLibNativeShared) -> String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> Platform -> String
dllExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_other, ForeignLibType
ForeignLibNativeStatic) -> String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> Platform -> String
staticLibExtension (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
(OS
_any, ForeignLibType
ForeignLibTypeUnknown) -> String -> String
forall a. String -> a
cabalBug String
"unknown foreign lib type"
where
nm :: String
nm :: String
nm = UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String) -> UnqualComponentName -> String
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 (String -> String -> String) -> String -> [String] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
(<.>) String
"so" ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
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)
(OS, ForeignLibType) -> (OS, ForeignLibType) -> Bool
forall a. Eq a => a -> a -> Bool
== (OS
Linux, ForeignLibType
ForeignLibNativeShared) =
let nums :: [Int]
nums = ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
os
in String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
<.> (String -> String -> String) -> String -> [String] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
(<.>) String
"so" ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show (Int -> [Int] -> [Int]
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 (UnqualComponentName -> String) -> UnqualComponentName -> String
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 ForeignLibOption -> [ForeignLibOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib
ForeignLibType
ForeignLibNativeStatic ->
Bool
False
ForeignLibType
ForeignLibTypeUnknown ->
String -> Bool
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} =
[Maybe ModuleName] -> Maybe ModuleName
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ModuleName] -> Maybe ModuleName)
-> [Maybe ModuleName] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ [Maybe ModuleName] -> [Maybe ModuleName]
forall a. [a] -> [a]
reverse ([Maybe ModuleName] -> [Maybe ModuleName])
-> [Maybe ModuleName] -> [Maybe ModuleName]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe ModuleName) -> [String] -> [Maybe ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe ModuleName
decodeMainIsArg ([String] -> [Maybe ModuleName]) -> [String] -> [Maybe ModuleName]
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 String -> [String] -> [String]
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 =
ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (String -> ModuleName
forall a. IsString a => String -> a
ModuleName.fromString String
main_mod)
| String -> (Char -> Bool) -> Bool
headOf String
arg Char -> Bool
isUpper
=
ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (String -> ModuleName
forall a. IsString a => String -> a
ModuleName.fromString String
arg)
| Bool
otherwise
=
Maybe ModuleName
forall a. Maybe a
Nothing
where
headOf :: String -> (Char -> Bool) -> Bool
headOf :: String -> (Char -> Bool) -> Bool
headOf String
str Char -> Bool
pred' = (Char -> Bool) -> Maybe Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
pred' (String -> Maybe Char
forall a. [a] -> Maybe a
safeHead String
str)
(String
main_mod, String
main_fn) = String -> (Char -> Bool) -> (String, String)
splitLongestPrefix String
arg (Char -> Char -> Bool
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'
| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r_pre = (String
str, [])
| Bool
otherwise = (String -> String
forall a. [a] -> [a]
reverse (String -> String
forall a. [a] -> [a]
safeTail String
r_pre), String -> String
forall a. [a] -> [a]
reverse String
r_suf)
where
(String
r_suf, String
r_pre) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
pred' (String -> String
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
-> PackageId
-> CabalSpecVersion
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources :: Verbosity
-> PackageId
-> CabalSpecVersion
-> String
-> GBuildMode
-> IO BuildSources
gbuildSources Verbosity
verbosity PackageId
pkgId 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 -> BuildSources -> IO BuildSources
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
GReplFLib [String]
_ ForeignLib
flib -> BuildSources -> IO BuildSources
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildSources -> IO BuildSources)
-> BuildSources -> IO BuildSources
forall a b. (a -> b) -> a -> b
$ ForeignLib -> BuildSources
flibSources ForeignLib
flib
where
exeSources :: Executable -> IO BuildSources
exeSources :: Executable -> IO BuildSources
exeSources exe :: Executable
exe@Executable{buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
bnfo, modulePath :: Executable -> String
modulePath = String
modPath} = do
main <- Verbosity -> [String] -> String -> IO String
findFileEx Verbosity
verbosity (String
tmpDir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bnfo)) String
modPath
let mainModName = ModuleName -> Maybe ModuleName -> ModuleName
forall a. a -> Maybe a -> a
fromMaybe ModuleName
ModuleName.main (Maybe ModuleName -> ModuleName) -> Maybe ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Executable -> Maybe ModuleName
exeMainModuleName Executable
exe
otherModNames = Executable -> [ModuleName]
exeModules Executable
exe
if isHaskell main || pkgId == fakePackageId
then
if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames)
then do
warn verbosity $
"Enabling workaround for Main module '"
++ prettyShow mainModName
++ "' listed in 'other-modules' illegally!"
return
BuildSources
{ cSourcesFiles = cSources bnfo
, cxxSourceFiles = cxxSources bnfo
, inputSourceFiles = [main]
, inputSourceModules = filter (/= mainModName) $ exeModules exe
}
else
return
BuildSources
{ cSourcesFiles = cSources bnfo
, cxxSourceFiles = cxxSources bnfo
, inputSourceFiles = [main]
, inputSourceModules = exeModules exe
}
else
let (csf, cxxsf)
| isCxx main = (cSources bnfo, main : cxxSources bnfo)
| otherwise = (main : cSources bnfo, cxxSources bnfo)
in return
BuildSources
{ cSourcesFiles = csf
, cxxSourceFiles = cxxsf
, inputSourceFiles = []
, inputSourceModules = exeModules 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
}
isCxx :: FilePath -> Bool
isCxx :: String -> Bool
isCxx String
fp = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
takeExtension String
fp) [String
".cpp", String
".cxx", String
".c++"]
isHaskell :: FilePath -> Bool
isHaskell :: String -> Bool
isHaskell String
fp = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
takeExtension String
fp) [String
".hs", String
".lhs"]
gbuild
:: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild :: Verbosity
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> GBuildMode
-> ComponentLocalBuildInfo
-> IO ()
gbuild Verbosity
verbosity Flag ParStrat
numJobs PackageDescription
pkg_descr LocalBuildInfo
lbi GBuildMode
bm ComponentLocalBuildInfo
clbi = do
(ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let replFlags = case GBuildMode
bm of
GReplExe [String]
flags Executable
_ -> [String]
flags
GReplFLib [String]
flags ForeignLib
_ -> [String]
flags
GBuildExe{} -> [String]
forall a. Monoid a => a
mempty
GBuildFLib{} -> [String]
forall a. Monoid a => a
mempty
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
runGhcProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
let (bnfo, threaded) = case bm of
GBuildFLib ForeignLib
_ -> BuildInfo -> (BuildInfo, Bool)
popThreadedFlag (GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm)
GBuildMode
_ -> (GBuildMode -> BuildInfo
gbuildInfo GBuildMode
bm, Bool
False)
let targetName = LocalBuildInfo -> GBuildMode -> String
gbuildTargetName LocalBuildInfo
lbi GBuildMode
bm
let targetDir = LocalBuildInfo -> String
buildDir LocalBuildInfo
lbi String -> String -> String
</> (GBuildMode -> String
gbuildName GBuildMode
bm)
let tmpDir = String
targetDir String -> String -> String
</> (GBuildMode -> String
gbuildName GBuildMode
bm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True tmpDir
let isCoverageEnabled = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
hpcdir Way
way
| GBuildMode -> Bool
gbuildIsRepl GBuildMode
bm = Flag String
forall a. Monoid a => a
mempty
| Bool
isCoverageEnabled = String -> Flag String
forall a. a -> Flag a
toFlag (String -> Flag String) -> String -> Flag String
forall a b. (a -> b) -> a -> b
$ String -> Way -> String
Hpc.mixDir (String
tmpDir String -> String -> String
</> String
extraCompilationArtifacts) Way
way
| Bool
otherwise = Flag String
forall a. Monoid a => a
mempty
rpaths <- getRPaths lbi clbi
buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm
let cSrcs = BuildSources -> [String]
cSourcesFiles BuildSources
buildSources
cxxSrcs = BuildSources -> [String]
cxxSourceFiles BuildSources
buildSources
inputFiles = BuildSources -> [String]
inputSourceFiles BuildSources
buildSources
inputModules = BuildSources -> [ModuleName]
inputSourceModules BuildSources
buildSources
isGhcDynamic = Compiler -> Bool
isDynamic Compiler
comp
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
cObjs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
cSrcs
cxxObjs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
`replaceExtension` String
objExtension) [String]
cxxSrcs
needDynamic = LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic LocalBuildInfo
lbi GBuildMode
bm
needProfiling = LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi
buildRunner = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo{} -> Bool
False
FLibComponentLocalBuildInfo{} -> Bool
False
ExeComponentLocalBuildInfo{} -> Bool
True
TestComponentLocalBuildInfo{} -> Bool
True
BenchComponentLocalBuildInfo{} -> Bool
True
baseOpts =
(Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bnfo ComponentLocalBuildInfo
clbi String
tmpDir)
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeMake
, ghcOptInputFiles =
toNubListR $
if package pkg_descr == fakePackageId
then filter isHaskell inputFiles
else inputFiles
, ghcOptInputScripts =
toNubListR $
if package pkg_descr == fakePackageId
then filter (not . isHaskell) inputFiles
else []
, ghcOptInputModules = toNubListR inputModules
,
ghcOptExtra =
if buildRunner
then ["-build-runner"]
else mempty
}
staticOpts =
GhcOptions
baseOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcStaticOnly
, ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts =
GhcOptions
baseOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
False
(withProfExeDetail lbi)
, ghcOptHiSuffix = toFlag "p_hi"
, ghcOptObjSuffix = toFlag "p_o"
, ghcOptExtra = hcProfOptions GHC bnfo
, ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts =
GhcOptions
baseOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcDynamicOnly
,
ghcOptFPic = toFlag True
, ghcOptHiSuffix = toFlag "dyn_hi"
, ghcOptObjSuffix = toFlag "dyn_o"
, ghcOptExtra = hcSharedOptions GHC bnfo
, ghcOptHPCDir = hpcdir Hpc.Dyn
}
dynTooOpts =
GhcOptions
staticOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
, ghcOptDynHiSuffix = toFlag "dyn_hi"
, ghcOptDynObjSuffix = toFlag "dyn_o"
, ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkOptions = PD.ldOptions bnfo
, ghcOptLinkLibs = extraLibs bnfo
, ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo
, ghcOptLinkFrameworks =
toNubListR $
PD.frameworks bnfo
, ghcOptLinkFrameworkDirs =
toNubListR $
PD.extraFrameworkDirs bnfo
, ghcOptInputFiles =
toNubListR
[tmpDir </> x | x <- cObjs ++ cxxObjs]
}
dynLinkerOpts =
GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptRPaths = rpaths
}
replOpts =
GhcOptions
baseOpts
{ ghcOptExtra =
Internal.filterGhciFlags
(ghcOptExtra baseOpts)
<> replFlags
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeInteractive
, ghcOptOptimisation = toFlag GhcNoOptimisation
}
commonOpts
| Bool
needProfiling = GhcOptions
profOpts
| Bool
needDynamic = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
compileOpts
| Bool
useDynToo = GhcOptions
dynTooOpts
| Bool
otherwise = GhcOptions
commonOpts
withStaticExe = Bool -> Bool
not Bool
needProfiling Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
needDynamic
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
bnfo
useDynToo =
Bool
dynamicTooSupported
Bool -> Bool -> Bool
&& Bool
isGhcDynamic
Bool -> Bool -> Bool
&& Bool
doingTH
Bool -> Bool -> Bool
&& Bool
withStaticExe
Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CompilerFlavor -> BuildInfo -> [String]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bnfo)
compileTHOpts
| Bool
isGhcDynamic = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
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)
when compileForTH $
runGhcProg
compileTHOpts
{ ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs
}
unless
( (null inputFiles && null inputModules)
|| gbuildIsRepl bm
)
$ runGhcProg
compileOpts
{ ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs
}
unless (null cxxSrcs) $ do
info verbosity "Building C++ Sources..."
sequence_
[ do
let baseCxxOpts =
Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
Internal.componentCxxGhcOptions
Verbosity
verbosity
LocalBuildInfo
lbi
BuildInfo
bnfo
ComponentLocalBuildInfo
clbi
String
tmpDir
String
filename
vanillaCxxOpts =
if Bool
isGhcDynamic
then
GhcOptions
baseCxxOpts{ghcOptFPic = toFlag True}
else GhcOptions
baseCxxOpts
profCxxOpts =
GhcOptions
vanillaCxxOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptProfilingMode = toFlag True
}
sharedCxxOpts =
GhcOptions
vanillaCxxOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptFPic = toFlag True
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
}
opts
| Bool
needProfiling = GhcOptions
profCxxOpts
| Bool
needDynamic = GhcOptions
sharedCxxOpts
| Bool
otherwise = GhcOptions
vanillaCxxOpts
odir = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
when needsRecomp $
runGhcProg opts
| filename <- cxxSrcs
]
unless (null cSrcs) $ do
info verbosity "Building C Sources..."
sequence_
[ do
let baseCcOpts =
Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> String
-> GhcOptions
Internal.componentCcGhcOptions
Verbosity
verbosity
LocalBuildInfo
lbi
BuildInfo
bnfo
ComponentLocalBuildInfo
clbi
String
tmpDir
String
filename
vanillaCcOpts =
if Bool
isGhcDynamic
then
GhcOptions
baseCcOpts{ghcOptFPic = toFlag True}
else GhcOptions
baseCcOpts
profCcOpts =
GhcOptions
vanillaCcOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptProfilingMode = toFlag True
}
sharedCcOpts =
GhcOptions
vanillaCcOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptFPic = toFlag True
, ghcOptDynLinkMode = toFlag GhcDynamicOnly
}
opts
| Bool
needProfiling = GhcOptions
profCcOpts
| Bool
needDynamic = GhcOptions
sharedCcOpts
| Bool
otherwise = GhcOptions
vanillaCcOpts
odir = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
when needsRecomp $
runGhcProg opts
| filename <- cSrcs
]
case 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
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkNoHsMain = toFlag (null inputFiles)
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi then GhcOptions
dynLinkerOpts else GhcOptions
forall a. Monoid a => a
mempty)
Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Linking..."
let target :: String
target = String
targetDir String -> String -> String
</> String
targetName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Version
compilerVersion Compiler
comp Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7, Int
7]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
e <- String -> IO Bool
doesFileExist String
target
when e (removeFile target)
GhcOptions -> IO ()
runGhcProg GhcOptions
linkOpts{ghcOptOutputFile = toFlag 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
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
dynLinkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptLinkNoHsMain = toFlag True
, ghcOptShared = toFlag True
, ghcOptLinkLibs = rtsOptLinkLibs
, ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
, ghcOptFPic = toFlag True
, ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
}
ForeignLibType
ForeignLibNativeStatic ->
String -> GhcOptions
forall a. String -> a
cabalBug String
"static libraries not yet implemented"
ForeignLibType
ForeignLibTypeUnknown ->
String -> GhcOptions
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 = toFlag (targetDir </> buildName)}
String -> String -> IO ()
renameFile (String
targetDir String -> String -> String
</> String
buildName) (String
targetDir String -> String -> String
</> String
targetName)
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 InstalledPackageIndex
-> PackageName -> [(Version, [InstalledPackageInfo])]
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 -> String -> RtsInfo
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 = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
"-ghc" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
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 = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag String
ghcOptObjDir GhcOptions
opts)
oext :: String
oext = String -> Flag String -> String
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
libraryPaths <- Bool
-> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
depLibraryPaths Bool
False (LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi) LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
let hostPref = case OS
hostOS of
OS
OSX -> String
"@loader_path"
OS
_ -> String
"$ORIGIN"
relPath String
p = if String -> Bool
isRelative String
p then String
hostPref String -> String -> String
</> String
p else String
p
rpaths = [String] -> NubListR String
forall a. Ord a => [a] -> NubListR a
toNubListR ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
relPath [String]
libraryPaths)
return rpaths
where
(Platform Arch
_ OS
hostOS) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
compid :: CompilerId
compid = Compiler -> CompilerId
compilerId (Compiler -> CompilerId)
-> (LocalBuildInfo -> Compiler) -> LocalBuildInfo -> CompilerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler (LocalBuildInfo -> CompilerId) -> LocalBuildInfo -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi
supportRPaths :: OS -> Bool
supportRPaths OS
Linux = Bool
True
supportRPaths OS
Windows = Bool
False
supportRPaths OS
OSX = Bool
True
supportRPaths OS
FreeBSD =
case CompilerId
compid of
CompilerId CompilerFlavor
GHC Version
ver | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
7, Int
10, Int
2] -> Bool
True
CompilerId
_ -> Bool
False
supportRPaths OS
OpenBSD = Bool
False
supportRPaths OS
NetBSD = Bool
False
supportRPaths OS
DragonFly = Bool
False
supportRPaths OS
Solaris = Bool
False
supportRPaths OS
AIX = Bool
False
supportRPaths OS
HPUX = Bool
False
supportRPaths OS
IRIX = Bool
False
supportRPaths OS
HaLVM = Bool
False
supportRPaths OS
IOS = Bool
False
supportRPaths OS
Android = Bool
False
supportRPaths OS
Ghcjs = Bool
False
supportRPaths OS
Wasi = Bool
False
supportRPaths OS
Hurd = Bool
True
supportRPaths OS
Haiku = Bool
False
supportRPaths (OtherOS String
_) = Bool
False
getRPaths LocalBuildInfo
_ ComponentLocalBuildInfo
_ = NubListR String -> IO (NubListR String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NubListR String
forall a. Monoid a => a
mempty
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag BuildInfo
bi =
( BuildInfo
bi{options = filterHcOptions (/= "-threaded") (options 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) =
[String] -> [String] -> PerCompilerFlavor [String]
forall v. v -> v -> PerCompilerFlavor v
PerCompilerFlavor ((String -> Bool) -> [String] -> [String]
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]
_) = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
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
vanillaArgs :: GhcOptions
vanillaArgs =
(Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi))
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptMode = toFlag GhcModeAbiHash
, ghcOptInputModules = toNubListR $ exposedModules lib
}
sharedArgs :: GhcOptions
sharedArgs =
GhcOptions
vanillaArgs
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptDynLinkMode = toFlag GhcDynamicOnly
, ghcOptFPic = toFlag True
, ghcOptHiSuffix = toFlag "js_dyn_hi"
, ghcOptObjSuffix = toFlag "js_dyn_o"
, ghcOptExtra = hcSharedOptions GHC libBi
}
profArgs :: GhcOptions
profArgs =
GhcOptions
vanillaArgs
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptProfilingMode = toFlag True
, ghcOptProfilingAuto =
Internal.profDetailLevelFlag
True
(withProfLibDetail lbi)
, ghcOptHiSuffix = toFlag "js_p_hi"
, ghcOptObjSuffix = toFlag "js_p_o"
, ghcOptExtra = hcProfOptions GHC 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 = String -> GhcOptions
forall a. HasCallStack => String -> a
error String
"libAbiHash: Can't find an enabled library way"
(ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
hash <-
getProgramInvocationOutput
verbosity
=<< ghcInvocation verbosity ghcjsProg comp platform ghcArgs
return (takeWhile (not . isSpace) 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
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> String
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi String
odir
in GhcOptions
opts
{ ghcOptExtra = ghcOptExtra opts `mappend` hcOptions GHCJS bi
}
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 (UnqualComponentName -> String) -> UnqualComponentName -> String
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
exeFileName :: String
exeFileName = String
exeName'
fixedExeBaseName :: String
fixedExeBaseName = String
progprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exeName' String -> String -> String
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) ([String] -> IO ()) -> [String] -> IO ()
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
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ case (LocalBuildInfo -> Bool
stripExes LocalBuildInfo
lbi, Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
stripProgram (ProgramDb -> Maybe ConfiguredProgram)
-> ProgramDb -> Maybe ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) of
(Bool
True, Just ConfiguredProgram
strip) -> [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 =
Bool -> String -> String -> String -> IO ()
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Suffix -> IO ()
copyModuleFiles (Suffix -> IO ()) -> Suffix -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Suffix
Suffix String
"js_hi"
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Suffix -> IO ()
copyModuleFiles (Suffix -> IO ()) -> Suffix -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Suffix
Suffix String
"js_p_hi"
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Suffix -> IO ()
copyModuleFiles (Suffix -> IO ()) -> Suffix -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Suffix
Suffix String
"js_dyn_hi"
IO () -> IO ()
whenHasCode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> String -> String -> IO ()
installOrdinary String
builtDir' String
targetDir (String -> String
toJSLibName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
mkGenericStaticLibName (String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f))
| String
l <- UnitId -> String
getHSLibraryName (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (BuildInfo -> [String]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib))
, String
f <- String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibFlavours (Library -> BuildInfo
libBuildInfo Library
lib)
]
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
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 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ String -> String -> String -> IO ()
installShared
String
builtDir'
String
dynlibTargetDir
(String -> String
toJSLibName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Platform -> CompilerId -> String -> String
mkGenericSharedLibName Platform
platform CompilerId
compiler_id (String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f))
| String
l <- UnitId -> String
getHSLibraryName UnitId
uid String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraBundledLibs (Library -> BuildInfo
libBuildInfo Library
lib)
, String
f <- String
"" String -> [String] -> [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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripLibs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isJS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> Platform -> ProgramDb -> 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 :: Suffix -> IO ()
copyModuleFiles Suffix
ext =
Verbosity
-> [String] -> [Suffix] -> [ModuleName] -> IO [(String, String)]
findModuleFilesEx Verbosity
verbosity [String
builtDir'] [Suffix
ext] (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
IO [(String, String)] -> ([(String, String)] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
[ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cSources (Library -> BuildInfo
libBuildInfo Library
lib))
Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cxxSources (Library -> BuildInfo
libBuildInfo Library
lib))
Bool -> Bool -> Bool
&& [String] -> Bool
forall a. [a] -> 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 = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_code
whenVanilla :: IO () -> IO ()
whenVanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
whenProf :: IO () -> IO ()
whenProf = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
has_code)
whenShared :: IO () -> IO ()
whenShared = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool
has_code)
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts String
hiSuf String
objSuf GhcOptions
opts =
GhcOptions
opts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty
{ ghcOptHiSuffix = toFlag hiSuf
, ghcOptObjSuffix = toFlag 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= (Char
'.' Char -> String -> String
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" String -> String
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" String -> String
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
, nativeMultiInstance :: Bool
HcPkg.nativeMultiInstance = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
, recacheMultiInstance :: Bool
HcPkg.recacheMultiInstance = Bool
True
, suppressFilesCheck :: Bool
HcPkg.suppressFilesCheck = Bool
True
}
where
v7_10 :: Version
v7_10 = [Int] -> Version
mkVersion [Int
7, Int
10]
ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (String -> ConfiguredProgram
forall a. HasCallStack => String -> a
error String
"GHCJS.hcPkgInfo no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsPkgProgram ProgramDb
progdb
ver :: Version
ver = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (String -> Version
forall a. HasCallStack => String -> a
error String
"GHCJS.hcPkgInfo no ghcjs version") (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsPkgProg
registerPackage
:: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage :: Verbosity
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity ProgramDb
progdb [PackageDB]
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions =
HcPkgInfo
-> Verbosity
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
HcPkg.register
(ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb)
Verbosity
verbosity
[PackageDB]
packageDbs
InstalledPackageInfo
installedPkgInfo
RegisterOptions
registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO String
pkgRoot Verbosity
verbosity LocalBuildInfo
lbi = PackageDB -> IO String
pkgRoot'
where
pkgRoot' :: PackageDB -> IO String
pkgRoot' PackageDB
GlobalPackageDB =
let ghcjsProg :: ConfiguredProgram
ghcjsProg = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (String -> ConfiguredProgram
forall a. HasCallStack => String -> a
error String
"GHCJS.pkgRoot: no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
in (String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
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
appDir <- String -> IO String
getAppUserDataDirectory String
"ghcjs"
let ver = Compiler -> Version
compilerVersion (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
subdir =
String
System.Info.arch
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'-'
Char -> String -> String
forall a. a -> [a] -> [a]
: String
System.Info.os
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'-'
Char -> String -> String
forall a. a -> [a] -> [a]
: Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver
rootDir = String
appDir String -> String -> String
</> String
subdir
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB String
fp) = String -> IO String
forall a. a -> IO a
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [String]
programOverrideArgs ConfiguredProgram
ghcjsProg [String] -> [String] -> [String]
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 = ConfiguredProgram -> Maybe ConfiguredProgram -> ConfiguredProgram
forall a. a -> Maybe a -> a
fromMaybe (String -> ConfiguredProgram
forall a. HasCallStack => String -> a
error String
"GHCJS.runCmd: no ghcjs program") (Maybe ConfiguredProgram -> ConfiguredProgram)
-> Maybe ConfiguredProgram -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb