module Distribution.Simple.GHCJS (
configure, getInstalledPackages, getPackageDBContents,
buildLib, buildExe,
replLib, replExe,
startInterpreter,
installLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
runCmd
) where
import Distribution.Simple.GHC.ImplInfo ( getImplInfo, ghcjsVersionImplInfo )
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..)
, Library(..), libModules, exeModules
, hcOptions, hcProfOptions, hcSharedOptions
, allExtensions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex ( InstalledPackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, LibraryName(..) )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
, ProgramSearchPath
, rawSystemProgramConf
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, getProgramInvocationOutput
, requireProgramVersion, requireProgram
, userMaybeSpecifyPath, programPath
, lookupProgram, addKnownPrograms
, ghcjsProgram, ghcjsPkgProgram, c2hsProgram, hsc2hsProgram
, ldProgram, haddockProgram, stripProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
( toFlag, fromFlag, configCoverage, configDistPref )
import qualified Distribution.Simple.Setup as Cabal
( Flag(..) )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..)
, PackageDB(..), PackageDBStack, AbiTag(..) )
import Distribution.Version
( Version(..), anyVersion, orLaterVersion )
import Distribution.System
( Platform(..) )
import Distribution.Verbosity
import Distribution.Utils.NubList
( overNubListR, toNubListR )
import Distribution.Text ( display )
import Language.Haskell.Extension ( Extension(..)
, KnownExtension(..))
import Control.Monad ( unless, when )
import Data.Char ( isSpace )
import qualified Data.Map as M ( fromList )
import Data.Monoid ( Monoid(..) )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
import Distribution.Compat.Exception (catchIO)
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration
-> IO (Compiler, Maybe Platform, ProgramConfiguration)
configure verbosity hcPath hcPkgPath conf0 = do
(ghcjsProg, ghcjsVersion, conf1) <-
requireProgramVersion verbosity ghcjsProgram
(orLaterVersion (Version [0,1] []))
(userMaybeSpecifyPath "ghcjs" hcPath conf0)
Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg)
let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion
(ghcjsPkgProg, ghcjsPkgVersion, conf2) <-
requireProgramVersion verbosity ghcjsPkgProgram {
programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg
}
anyVersion (userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath conf1)
Just ghcjsPkgGhcVersion <- findGhcjsPkgGhcVersion
verbosity (programPath ghcjsPkgProg)
when (ghcjsVersion /= ghcjsPkgVersion) $ die $
"Version mismatch between ghcjs and ghcjs-pkg: "
++ programPath ghcjsProg ++ " is version " ++ display ghcjsVersion ++ " "
++ programPath ghcjsPkgProg ++ " is version " ++ display ghcjsPkgVersion
when (ghcjsGhcVersion /= ghcjsPkgGhcVersion) $ die $
"Version mismatch between ghcjs and ghcjs-pkg: "
++ programPath ghcjsProg
++ " was built with GHC version " ++ display ghcjsGhcVersion ++ " "
++ programPath ghcjsPkgProg
++ " was built with GHC version " ++ display ghcjsPkgGhcVersion
let hsc2hsProgram' =
hsc2hsProgram { programFindLocation =
guessHsc2hsFromGhcjsPath ghcjsProg }
c2hsProgram' =
c2hsProgram { programFindLocation =
guessC2hsFromGhcjsPath ghcjsProg }
haddockProgram' =
haddockProgram { programFindLocation =
guessHaddockFromGhcjsPath ghcjsProg }
conf3 = addKnownPrograms [ hsc2hsProgram', c2hsProgram', haddockProgram' ] conf2
languages <- Internal.getLanguages verbosity implInfo ghcjsProg
extensions <- Internal.getExtensions verbosity implInfo ghcjsProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg
let ghcInfoMap = M.fromList ghcInfo
let comp = Compiler {
compilerId = CompilerId GHCJS ghcjsVersion,
compilerAbiTag = AbiTag $
"ghc" ++ intercalate "_" (map show . versionBranch $ ghcjsGhcVersion),
compilerCompat = [CompilerId GHC ghcjsGhcVersion],
compilerLanguages = languages,
compilerExtensions = extensions,
compilerProperties = ghcInfoMap
}
compPlatform = Internal.targetPlatform ghcInfo
let conf4 = if ghcjsNativeToo comp
then Internal.configureToolchain implInfo
ghcjsProg ghcInfoMap conf3
else conf3
return (comp, compPlatform, conf4)
ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo = Internal.ghcLookupProperty "Native Too"
guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe FilePath)
guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram
guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe FilePath)
guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram
guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe FilePath)
guessC2hsFromGhcjsPath = guessToolFromGhcjsPath c2hsProgram
guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe FilePath)
guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram
guessToolFromGhcjsPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe FilePath)
guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath
= do let toolname = programName tool
path = programPath ghcjsProg
dir = takeDirectory path
versionSuffix = takeVersionSuffix (dropExeExtension path)
guessNormal = dir </> toolname <.> exeExtension
guessGhcjsVersioned = dir </> (toolname ++ "-ghcjs" ++ versionSuffix)
<.> exeExtension
guessGhcjs = dir </> (toolname ++ "-ghcjs")
<.> exeExtension
guessVersioned = dir </> (toolname ++ versionSuffix) <.> exeExtension
guesses | null versionSuffix = [guessGhcjs, guessNormal]
| otherwise = [guessGhcjsVersioned,
guessGhcjs,
guessVersioned,
guessNormal]
info verbosity $ "looking for tool " ++ toolname
++ " near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
return (Just fp)
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") .
reverse
dropExeExtension :: FilePath -> FilePath
dropExeExtension filepath =
case splitExtension filepath of
(filepath', extension) | extension == exeExtension -> filepath'
| otherwise -> filepath
getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO InstalledPackageIndex
getPackageDBContents verbosity packagedb conf = do
pkgss <- getInstalledPackages' verbosity [packagedb] conf
toPackageIndex verbosity pkgss conf
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbEnvVar
checkPackageDbStack packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs conf
index <- toPackageIndex verbosity pkgss conf
return $! index
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramConfiguration
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss conf = do
topDir <- getLibDir' verbosity ghcjsProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! (mconcat indices)
where
Just ghcjsProg = lookupProgram ghcjsProgram conf
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar =
Internal.checkPackageDbEnvVar "GHCJS" "GHCJS_PACKAGE_PATH"
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStack rest
| GlobalPackageDB `notElem` rest =
die $ "With current ghc versions the global package db is always used "
++ "and must be listed first. This ghc limitation may be lifted in "
++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStack _ =
die $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf =
sequence
[ do pkgs <- HcPkg.dump (hcPkgInfo conf) verbosity packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs ]
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
(reverse . dropWhile isSpace . reverse) `fmap`
rawSystemProgramStdoutConf verbosity ghcjsProgram
(withPrograms lbi) ["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity ghcjsProg =
(reverse . dropWhile isSpace . reverse) `fmap`
rawSystemProgramStdout verbosity ghcjsProg ["--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcjsProg =
(reverse . dropWhile isSpace . reverse) `fmap`
rawSystemProgramStdout verbosity ghcjsProg ["--print-global-package-db"]
toJSLibName :: String -> String
toJSLibName lib
| takeExtension lib `elem` [".dll",".dylib",".so"]
= replaceExtension lib "js_so"
| takeExtension lib == ".a" = replaceExtension lib "js_a"
| otherwise = lib <.> "js_a"
buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
-> IO ()
buildLib = buildOrReplLib False
replLib = buildOrReplLib True
buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
libName <- case componentLibraries clbi of
[libName] -> return libName
[] -> die "No library name found when building library"
_ -> die "Multiple library names found when building library"
let libTargetDir = buildDir lbi
whenVanillaLib forceVanilla =
when (not forRepl && (forceVanilla || withVanillaLib lbi))
whenProfLib = when (not forRepl && withProfLib lbi)
whenSharedLib forceShared =
when (not forRepl && (forceShared || withSharedLib lbi))
whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi)
ifReplLib = when forRepl
comp = compiler lbi
implInfo = getImplInfo comp
hole_insts = map (\(k,(p,n)) -> (k,(InstalledPackageInfo.packageKey p,n)))
(instantiatedWith lbi)
nativeToo = ghcjsNativeToo comp
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
let runGhcjsProg = runGHC verbosity ghcjsProg comp
libBi = libBuildInfo lib
isGhcjsDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcjsDynamic
forceSharedLib = doingTH && isGhcjsDynamic
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
cname = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
jsSrcs = jsSources libBi
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
linkJsLibOpts = mempty {
ghcOptExtra = toNubListR $
[ "-link-js-lib" , (\(LibraryName l) -> l) libName
, "-js-lib-outputdir", libTargetDir ] ++
concatMap (\x -> ["-js-lib-src",x]) jsSrcs
}
vanillaOptsNoJsLib = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = numJobs,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptSigOf = hole_insts,
ghcOptInputModules = toNubListR $ libModules lib,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
vanillaOpts = vanillaOptsNoJsLib `mappend` linkJsLibOpts
profOpts = adjustExts "p_hi" "p_o" vanillaOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptExtra = toNubListR $
ghcjsProfOptions libBi,
ghcOptHPCDir = hpcdir Hpc.Prof
}
sharedOpts = adjustExts "dyn_hi" "dyn_o" vanillaOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptExtra = toNubListR $
ghcjsSharedOptions libBi,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptInputFiles =
toNubListR $ [libTargetDir </> x | x <- cObjs] ++ jsSrcs
}
replOpts = vanillaOptsNoJsLib {
ghcOptExtra = overNubListR
Internal.filterGhciFlags
(ghcOptExtra vanillaOpts),
ghcOptNumJobs = mempty
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
vanillaSharedOpts = vanillaOpts `mappend`
mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptDynHiSuffix = toFlag "dyn_hi",
ghcOptDynObjSuffix = toFlag "dyn_o",
ghcOptHPCDir = hpcdir Hpc.Dyn
}
unless (forRepl || (null (libModules lib) && null jsSrcs && null cObjs)) $
do let vanilla = whenVanillaLib forceVanillaLib (runGhcjsProg vanillaOpts)
shared = whenSharedLib forceSharedLib (runGhcjsProg sharedOpts)
useDynToo = dynamicTooSupported &&
(forceVanillaLib || withVanillaLib lbi) &&
(forceSharedLib || withSharedLib lbi) &&
null (ghcjsSharedOptions libBi)
if useDynToo
then do
runGhcjsProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
(Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do
copyDirectoryRecursive verbosity dynDir vanillaDir
_ -> return ()
else if isGhcjsDynamic
then do shared; vanilla
else do vanilla; shared
whenProfLib (runGhcjsProg profOpts)
unless (null (cSources libBi) || not nativeToo) $ do
info verbosity "Building C Sources..."
sequence_
[ do let vanillaCcOpts =
(Internal.componentCcGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename)
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaCcOpts)
createDirectoryIfMissingVerbose verbosity True odir
runGhcjsProg vanillaCcOpts
whenSharedLib forceSharedLib (runGhcjsProg sharedCcOpts)
whenProfLib (runGhcjsProg profCcOpts)
| filename <- cSources libBi]
unless (null (libModules lib)) $
ifReplLib (runGhcjsProg replOpts)
when (nativeToo && not forRepl) $ do
info verbosity "Linking..."
let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
cid = compilerId (compiler lbi)
vanillaLibFilePath = libTargetDir </> mkLibName libName
profileLibFilePath = libTargetDir </> mkProfLibName libName
sharedLibFilePath = libTargetDir </> mkSharedLibName cid libName
ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName libName
hObjs <- Internal.getHaskellObjects implInfo lib lbi
libTargetDir objExtension True
hProfObjs <-
if (withProfLib lbi)
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if (withSharedLib lbi)
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("dyn_" ++ objExtension) False
else return []
unless (null hObjs && null cObjs) $ do
let staticObjectFiles =
hObjs
++ map (libTargetDir </>) cObjs
profObjectFiles =
hProfObjs
++ map (libTargetDir </>) cProfObjs
ghciObjFiles =
hObjs
++ map (libTargetDir </>) cObjs
dynamicObjectFiles =
hSharedObjs
++ map (libTargetDir </>) cSharedObjs
ghcSharedLinkArgs =
mempty {
ghcOptShared = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $
Internal.mkGhcOptPackages clbi,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi
}
whenVanillaLib False $ do
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenProfLib $ do
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity ldProg
ghciLibFilePath ghciObjFiles
whenSharedLib False $
runGhcjsProg ghcSharedLinkArgs
startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler
-> PackageDBStack -> IO ()
startInterpreter verbosity conf comp packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack packageDBs
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram conf
runGHC verbosity ghcjsProg comp replOpts
buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe = buildOrReplExe False
replExe = buildOrReplExe True
buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
let comp = compiler lbi
implInfo = getImplInfo comp
runGhcjsProg = runGHC verbosity ghcjsProg comp
exeBi = buildInfo exe
let exeNameReal = exeName' <.>
(if takeExtension exeName' /= ('.':exeExtension)
then exeExtension
else "")
let targetDir = (buildDir lbi) </> exeName'
let exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName'
| otherwise = mempty
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
let isGhcjsDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
buildRunner = case clbi of
ExeComponentLocalBuildInfo {} -> False
_ -> True
isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
jsSrcs = jsSources exeBi
cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain]
cObjs = map (`replaceExtension` objExtension) cSrcs
nativeToo = ghcjsNativeToo comp
baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
`mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptInputFiles = toNubListR $
[ srcMainFile | isHaskellMain],
ghcOptInputModules = toNubListR $
[ m | not isHaskellMain, m <- exeModules exe],
ghcOptExtra =
if buildRunner then toNubListR ["-build-runner"]
else mempty
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = adjustExts "p_hi" "p_o" baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptExtra = toNubListR $ ghcjsProfOptions exeBi,
ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts = adjustExts "dyn_hi" "dyn_o" baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptExtra = toNubListR $
ghcjsSharedOptions exeBi,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
dynTooOpts = adjustExts "dyn_hi" "dyn_o" staticOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = toNubListR $ PD.ldOptions exeBi,
ghcOptLinkLibs = toNubListR $ extraLibs exeBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
ghcOptInputFiles = toNubListR $
[exeDir </> x | x <- cObjs] ++ jsSrcs
}
replOpts = baseOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags
(ghcOptExtra baseOpts)
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
commonOpts | withProfExe lbi = profOpts
| withDynExe lbi = dynOpts
| otherwise = staticOpts
compileOpts | useDynToo = dynTooOpts
| otherwise = commonOpts
withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi)
doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi
useDynToo = dynamicTooSupported && isGhcjsDynamic
&& doingTH && withStaticExe && null (ghcjsSharedOptions exeBi)
compileTHOpts | isGhcjsDynamic = dynOpts
| otherwise = staticOpts
compileForTH
| forRepl = False
| useDynToo = False
| isGhcjsDynamic = doingTH && (withProfExe lbi || withStaticExe)
| otherwise = doingTH && (withProfExe lbi || withDynExe lbi)
linkOpts = commonOpts `mappend`
linkerOpts `mappend` mempty {
ghcOptLinkNoHsMain = toFlag (not isHaskellMain)
}
when compileForTH $
runGhcjsProg compileTHOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless forRepl $
runGhcjsProg compileOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless (null cSrcs || not nativeToo) $ do
info verbosity "Building C Sources..."
sequence_
[ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi
clbi exeDir filename) `mappend` mempty {
ghcOptDynLinkMode = toFlag (if withDynExe lbi
then GhcDynamicOnly
else GhcStaticOnly),
ghcOptProfilingMode = toFlag (withProfExe lbi)
}
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
runGhcjsProg opts
| filename <- cSrcs ]
when forRepl $ runGhcjsProg replOpts
unless forRepl $ do
info verbosity "Linking..."
runGhcjsProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> exeNameReal) }
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
whenVanilla $ copyModuleFiles "js_hi"
whenProf $ copyModuleFiles "js_p_hi"
whenShared $ copyModuleFiles "js_dyn_hi"
whenVanilla $ mapM_ (installOrdinary builtDir targetDir . toJSLibName) vanillaLibNames
whenProf $ mapM_ (installOrdinary builtDir targetDir . toJSLibName) profileLibNames
whenShared $ mapM_ (installShared builtDir dynlibTargetDir . toJSLibName) sharedLibNames
when (ghcjsNativeToo $ compiler lbi) $ do
whenVanilla $ copyModuleFiles "hi"
whenProf $ copyModuleFiles "p_hi"
whenShared $ copyModuleFiles "dyn_hi"
whenVanilla $ mapM_ (installOrdinary builtDir targetDir) vanillaLibNames
whenProf $ mapM_ (installOrdinary builtDir targetDir) profileLibNames
whenGHCi $ mapM_ (installOrdinary builtDir targetDir) ghciLibNames
whenShared $ mapM_ (installShared builtDir dynlibTargetDir) sharedLibNames
where
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
if isShared
then do when (stripLibs lbi) $ Strip.stripLib verbosity
(hostPlatform lbi) (withPrograms lbi) src
installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
installOrdinary = install False
installShared = install True
copyModuleFiles ext =
findModuleFiles [builtDir] [ext] (libModules lib)
>>= installOrdinaryFiles verbosity targetDir
cid = compilerId (compiler lbi)
libNames = componentLibraries clbi
vanillaLibNames = map mkLibName libNames
profileLibNames = map mkProfLibName libNames
ghciLibNames = map Internal.mkGHCiLibName libNames
sharedLibNames = map (mkSharedLibName cid) libNames
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
whenVanilla = when (hasLib && withVanillaLib lbi)
whenProf = when (hasLib && withProfLib lbi)
whenGHCi = when (hasLib && withGHCiLib lbi)
whenShared = when (hasLib && withSharedLib lbi)
installExe :: Verbosity
-> LocalBuildInfo
-> InstallDirs FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity lbi installDirs buildPref
(progprefix, progsuffix) _pkg exe = do
let binDir = bindir installDirs
createDirectoryIfMissingVerbose verbosity True binDir
let exeFileName = exeName exe
fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix
installBinary dest = do
rawSystemProgramConf verbosity ghcjsProgram (withPrograms lbi) $
[ "--install-executable"
, buildPref </> exeName exe </> exeFileName
, "-o", dest
] ++
case (stripExes lbi, lookupProgram stripProgram $ withPrograms lbi) of
(True, Just strip) -> ["-strip-program", programPath strip]
_ -> []
installBinary (binDir </> fixedExeBaseName)
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity _pkg_descr lbi lib clbi = do
let
libBi = libBuildInfo lib
comp = compiler lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptInputModules = toNubListR $ exposedModules lib
}
profArgs = adjustExts "js_p_hi" "js_p_o" vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptExtra = toNubListR (ghcjsProfOptions libBi)
}
ghcArgs = if withVanillaLib lbi then vanillaArgs
else if withProfLib lbi then profArgs
else error "libAbiHash: Can't find an enabled library way"
(ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
getProgramInvocationOutput verbosity (ghcInvocation ghcjsProg comp ghcArgs)
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts hiSuf objSuf opts =
opts `mappend` mempty {
ghcOptHiSuffix = toFlag hiSuf,
ghcOptObjSuffix = toFlag objSuf
}
registerPackage :: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs
(Right installedPkgInfo)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions verbosity lbi bi clbi odir =
let opts = Internal.componentGhcOptions verbosity lbi bi clbi odir
in opts { ghcOptExtra = ghcOptExtra opts `mappend` toNubListR
(hcOptions GHCJS bi)
}
ghcjsProfOptions :: BuildInfo -> [String]
ghcjsProfOptions bi =
hcProfOptions GHC bi `mappend` hcProfOptions GHCJS bi
ghcjsSharedOptions :: BuildInfo -> [String]
ghcjsSharedOptions bi =
hcSharedOptions GHC bi `mappend` hcSharedOptions GHCJS bi
isDynamic :: Compiler -> Bool
isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion verbosity pgm =
findProgramVersion "--numeric-ghc-version" id verbosity pgm
findGhcjsPkgGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcVersion verbosity pgm =
findProgramVersion "--numeric-ghc-version" id verbosity pgm
hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo
hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg
, HcPkg.noPkgDbStack = False
, HcPkg.noVerboseFlag = False
, HcPkg.flagPackageConf = False
}
where
Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram conf
runCmd :: ProgramConfiguration -> FilePath
-> (FilePath, FilePath, [String])
runCmd conf exe =
( script
, programPath ghcjsProg
, programDefaultArgs ghcjsProg ++ programOverrideArgs ghcjsProg ++ ["--run"]
)
where
script = exe <.> "jsexe" </> "all" <.> "js"
Just ghcjsProg = lookupProgram ghcjsProgram conf