{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.GHCJS (
configure, getInstalledPackages, getPackageDBContents,
buildLib, buildExe,
replLib, replExe,
startInterpreter,
installLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
runCmd
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.UnqualComponentName
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo
import Distribution.Simple.PackageIndex ( InstalledPackageIndex )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup hiding ( Flag )
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler hiding ( Flag )
import Distribution.Version
import Distribution.System
import Distribution.Verbosity
import Distribution.Utils.NubList
import Distribution.Pretty
import Distribution.Types.UnitId
import qualified Data.Map as Map
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension )
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity :: Verbosity
verbosity hcPath :: Maybe FilePath
hcPath hcPkgPath :: Maybe FilePath
hcPkgPath progdb0 :: ProgramDb
progdb0 = do
(ghcjsProg :: ConfiguredProgram
ghcjsProg, ghcjsVersion :: Version
ghcjsVersion, progdb1 :: ProgramDb
progdb1) <-
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcjsProgram
(Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [0,1]))
(FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath "ghcjs" Maybe FilePath
hcPath ProgramDb
progdb0)
Just ghcjsGhcVersion :: Version
ghcjsGhcVersion <- Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg)
let implInfo :: GhcImplInfo
implInfo = Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo Version
ghcjsVersion Version
ghcjsGhcVersion
(ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg, ghcjsPkgVersion :: Version
ghcjsPkgVersion, progdb2 :: ProgramDb
progdb2) <-
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
ghcjsPkgProgram {
programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath ConfiguredProgram
ghcjsProg
}
VersionRange
anyVersion (FilePath -> Maybe FilePath -> ProgramDb -> ProgramDb
userMaybeSpecifyPath "ghcjs-pkg" Maybe FilePath
hcPkgPath ProgramDb
progdb1)
Just ghcjsPkgGhcjsVersion :: Version
ghcjsPkgGhcjsVersion <- Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion
Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgGhcjsVersion) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
"Version mismatch between ghcjs and ghcjs-pkg: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " is version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsPkgGhcjsVersion
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
ghcjsGhcVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
ghcjsPkgVersion) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
"Version mismatch between ghcjs and ghcjs-pkg: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " was built with GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsGhcVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsPkgProg
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " was built with GHC version " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
ghcjsPkgVersion
let hsc2hsProgram' :: Program
hsc2hsProgram' =
Program
hsc2hsProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath ConfiguredProgram
ghcjsProg }
c2hsProgram' :: Program
c2hsProgram' =
Program
c2hsProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath ConfiguredProgram
ghcjsProg }
haddockProgram' :: Program
haddockProgram' =
Program
haddockProgram { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation =
ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath ConfiguredProgram
ghcjsProg }
progdb3 :: ProgramDb
progdb3 = [Program] -> ProgramDb -> ProgramDb
addKnownPrograms [ Program
hsc2hsProgram', Program
c2hsProgram', Program
haddockProgram' ] ProgramDb
progdb2
[(Language, FilePath)]
languages <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> NoCallStackIO [(Language, FilePath)]
Internal.getLanguages Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
[(Extension, Maybe FilePath)]
extensions <- Verbosity
-> GhcImplInfo
-> ConfiguredProgram
-> IO [(Extension, Maybe FilePath)]
Internal.getExtensions Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
[(FilePath, FilePath)]
ghcInfo <- Verbosity
-> GhcImplInfo -> ConfiguredProgram -> IO [(FilePath, FilePath)]
Internal.getGhcInfo Verbosity
verbosity GhcImplInfo
implInfo ConfiguredProgram
ghcjsProg
let ghcInfoMap :: Map FilePath FilePath
ghcInfoMap = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath, FilePath)]
ghcInfo
let comp :: Compiler
comp = Compiler :: CompilerId
-> AbiTag
-> [CompilerId]
-> [(Language, FilePath)]
-> [(Extension, Maybe FilePath)]
-> Map FilePath FilePath
-> Compiler
Compiler {
compilerId :: CompilerId
compilerId = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHCJS Version
ghcjsVersion,
compilerAbiTag :: AbiTag
compilerAbiTag = FilePath -> AbiTag
AbiTag (FilePath -> AbiTag) -> FilePath -> AbiTag
forall a b. (a -> b) -> a -> b
$
"ghc" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "_" ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show ([Int] -> [FilePath])
-> (Version -> [Int]) -> Version -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers (Version -> [FilePath]) -> Version -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Version
ghcjsGhcVersion),
compilerCompat :: [CompilerId]
compilerCompat = [CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHC Version
ghcjsGhcVersion],
compilerLanguages :: [(Language, FilePath)]
compilerLanguages = [(Language, FilePath)]
languages,
compilerExtensions :: [(Extension, Maybe FilePath)]
compilerExtensions = [(Extension, Maybe FilePath)]
extensions,
compilerProperties :: Map FilePath FilePath
compilerProperties = Map FilePath FilePath
ghcInfoMap
}
compPlatform :: Maybe Platform
compPlatform = [(FilePath, FilePath)] -> Maybe Platform
Internal.targetPlatform [(FilePath, FilePath)]
ghcInfo
let progdb4 :: ProgramDb
progdb4 = if Compiler -> Bool
ghcjsNativeToo Compiler
comp
then GhcImplInfo
-> ConfiguredProgram
-> Map FilePath FilePath
-> ProgramDb
-> ProgramDb
Internal.configureToolchain GhcImplInfo
implInfo
ConfiguredProgram
ghcjsProg Map FilePath FilePath
ghcInfoMap ProgramDb
progdb3
else ProgramDb
progdb3
(Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
compPlatform, ProgramDb
progdb4)
ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo :: Compiler -> Bool
ghcjsNativeToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "Native Too"
guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcjsPkgFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
ghcjsPkgProgram
guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
hsc2hsProgram
guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessC2hsFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
c2hsProgram
guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath :: ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcjsPath = Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath Program
haddockProgram
guessToolFromGhcjsPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath :: Program
-> ConfiguredProgram
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcjsPath tool :: Program
tool ghcjsProg :: ConfiguredProgram
ghcjsProg verbosity :: Verbosity
verbosity searchpath :: ProgramSearchPath
searchpath
= do let toolname :: FilePath
toolname = Program -> FilePath
programName Program
tool
path :: FilePath
path = ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
path
versionSuffix :: FilePath
versionSuffix = FilePath -> FilePath
takeVersionSuffix (FilePath -> FilePath
dropExeExtension FilePath
path)
guessNormal :: FilePath
guessNormal = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
toolname FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessGhcjsVersioned :: FilePath
guessGhcjsVersioned = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-ghcjs" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
versionSuffix)
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessGhcjs :: FilePath
guessGhcjs = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-ghcjs")
FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guessVersioned :: FilePath
guessVersioned = FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
versionSuffix) FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
buildPlatform
guesses :: [FilePath]
guesses | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
versionSuffix = [FilePath
guessGhcjs, FilePath
guessNormal]
| Bool
otherwise = [FilePath
guessGhcjsVersioned,
FilePath
guessGhcjs,
FilePath
guessVersioned,
FilePath
guessNormal]
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "looking for tool " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " near compiler in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
[Bool]
exists <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Bool
doesFileExist [FilePath]
guesses
case [ FilePath
file | (file :: FilePath
file, True) <- [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists ] of
[] -> Program
-> Verbosity
-> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
programFindLocation Program
tool Verbosity
verbosity ProgramSearchPath
searchpath
(fp :: FilePath
fp:_) -> do Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
toolname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
let lookedAt :: [FilePath]
lookedAt = ((FilePath, Bool) -> FilePath) -> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst
([(FilePath, Bool)] -> [FilePath])
-> ([(FilePath, Bool)] -> [(FilePath, Bool)])
-> [(FilePath, Bool)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Bool) -> Bool)
-> [(FilePath, Bool)] -> [(FilePath, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(_file :: FilePath
_file, exist :: Bool
exist) -> Bool -> Bool
not Bool
exist)
([(FilePath, Bool)] -> [FilePath])
-> [(FilePath, Bool)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
guesses [Bool]
exists
Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, [FilePath]) -> Maybe (FilePath, [FilePath])
forall a. a -> Maybe a
Just (FilePath
fp, [FilePath]
lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix :: FilePath -> FilePath
takeVersionSuffix = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (`elem ` "0123456789.-") (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath -> FilePath
forall a. [a] -> [a]
reverse
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents verbosity :: Verbosity
verbosity packagedb :: PackageDB
packagedb progdb :: ProgramDb
progdb = do
[(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB
packagedb] ProgramDb
progdb
Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages :: Verbosity -> [PackageDB] -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackages verbosity :: Verbosity
verbosity packagedbs :: [PackageDB]
packagedbs progdb :: ProgramDb
progdb = do
Verbosity -> IO ()
checkPackageDbEnvVar Verbosity
verbosity
Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
packagedbs
[(PackageDB, [InstalledPackageInfo])]
pkgss <- Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' Verbosity
verbosity [PackageDB]
packagedbs ProgramDb
progdb
InstalledPackageIndex
index <- Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex Verbosity
verbosity [(PackageDB, [InstalledPackageInfo])]
pkgss ProgramDb
progdb
InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! InstalledPackageIndex
index
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex verbosity :: Verbosity
verbosity pkgss :: [(PackageDB, [InstalledPackageInfo])]
pkgss progdb :: ProgramDb
progdb = do
FilePath
topDir <- Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' Verbosity
verbosity ConfiguredProgram
ghcjsProg
let indices :: [InstalledPackageIndex]
indices = [ [InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList ((InstalledPackageInfo -> InstalledPackageInfo)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> InstalledPackageInfo -> InstalledPackageInfo
Internal.substTopDir FilePath
topDir) [InstalledPackageInfo]
pkgs)
| (_, pkgs :: [InstalledPackageInfo]
pkgs) <- [(PackageDB, [InstalledPackageInfo])]
pkgss ]
InstalledPackageIndex -> IO InstalledPackageIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex -> IO InstalledPackageIndex)
-> InstalledPackageIndex -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$! ([InstalledPackageIndex] -> InstalledPackageIndex
forall a. Monoid a => [a] -> a
mconcat [InstalledPackageIndex]
indices)
where
Just ghcjsProg :: ConfiguredProgram
ghcjsProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar verbosity :: Verbosity
verbosity =
Verbosity -> FilePath -> FilePath -> IO ()
Internal.checkPackageDbEnvVar Verbosity
verbosity "GHCJS" "GHCJS_PACKAGE_PATH"
checkPackageDbStack :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStack :: Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack _ (GlobalPackageDB:rest :: [PackageDB]
rest)
| PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkPackageDbStack verbosity :: Verbosity
verbosity rest :: [PackageDB]
rest
| PackageDB
GlobalPackageDB PackageDB -> [PackageDB] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageDB]
rest =
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "With current ghc versions the global package db is always used "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "and must be listed first. This ghc limitation may be lifted in "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "future, see http://ghc.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStack verbosity :: Verbosity
verbosity _ =
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "If the global package db is specified, it must be "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "specified first and cannot be specified multiple times"
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' :: Verbosity
-> [PackageDB]
-> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity :: Verbosity
verbosity packagedbs :: [PackageDB]
packagedbs progdb :: ProgramDb
progdb =
[IO (PackageDB, [InstalledPackageInfo])]
-> IO [(PackageDB, [InstalledPackageInfo])]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ do [InstalledPackageInfo]
pkgs <- HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
HcPkg.dump (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity PackageDB
packagedb
(PackageDB, [InstalledPackageInfo])
-> IO (PackageDB, [InstalledPackageInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDB
packagedb, [InstalledPackageInfo]
pkgs)
| PackageDB
packagedb <- [PackageDB]
packagedbs ]
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi =
(FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity Program
ghcjsProgram
(LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) ["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity :: Verbosity
verbosity ghcjsProg :: ConfiguredProgram
ghcjsProg =
(FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcjsProg ["--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity :: Verbosity
verbosity ghcjsProg :: ConfiguredProgram
ghcjsProg =
(FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
Verbosity -> ConfiguredProgram -> [FilePath] -> IO FilePath
getProgramOutput Verbosity
verbosity ConfiguredProgram
ghcjsProg ["--print-global-package-db"]
toJSLibName :: String -> String
toJSLibName :: FilePath -> FilePath
toJSLibName lib :: FilePath
lib
| FilePath -> FilePath
takeExtension FilePath
lib FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [".dll",".dylib",".so"]
= FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib "js_so"
| FilePath -> FilePath
takeExtension FilePath
lib FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".a" = FilePath -> FilePath -> FilePath
replaceExtension FilePath
lib "js_a"
| Bool
otherwise = FilePath
lib FilePath -> FilePath -> FilePath
<.> "js_a"
buildLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
-> IO ()
buildLib :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib Maybe [FilePath]
forall a. Maybe a
Nothing
replLib :: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
replLib :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
replLib = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib (Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ())
-> ([FilePath] -> Maybe [FilePath])
-> [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just
buildOrReplLib :: Maybe [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
buildOrReplLib :: Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplLib mReplFlags :: Maybe [FilePath]
mReplFlags verbosity :: Verbosity
verbosity numJobs :: Flag (Maybe Int)
numJobs pkg_descr :: PackageDescription
pkg_descr lbi :: LocalBuildInfo
lbi lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
let uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
libTargetDir :: FilePath
libTargetDir = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi
whenVanillaLib :: Bool -> f () -> f ()
whenVanillaLib forceVanilla :: Bool
forceVanilla =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& (Bool
forceVanilla Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi))
whenProfLib :: IO () -> IO ()
whenProfLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
whenSharedLib :: Bool -> f () -> f ()
whenSharedLib forceShared :: Bool
forceShared =
Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& (Bool
forceShared Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi))
whenGHCiLib :: IO () -> IO ()
whenGHCiLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
forRepl Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi)
forRepl :: Bool
forRepl = Bool -> ([FilePath] -> Bool) -> Maybe [FilePath] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> [FilePath] -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe [FilePath]
mReplFlags
ifReplLib :: IO () -> IO ()
ifReplLib = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forRepl
replFlags :: [FilePath]
replFlags = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [FilePath]
forall a. Monoid a => a
mempty Maybe [FilePath]
mReplFlags
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
nativeToo :: Bool
nativeToo = Compiler -> Bool
ghcjsNativeToo Compiler
comp
(ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let runGhcjsProg :: GhcOptions -> IO ()
runGhcjsProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib
isGhcjsDynamic :: Bool
isGhcjsDynamic = Compiler -> Bool
isDynamic Compiler
comp
dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
libBi
forceVanillaLib :: Bool
forceVanillaLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isGhcjsDynamic
forceSharedLib :: Bool
forceSharedLib = Bool
doingTH Bool -> Bool -> Bool
&& Bool
isGhcjsDynamic
let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
libCoverage LocalBuildInfo
lbi
pkg_name :: FilePath
pkg_name = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> FilePath) -> PackageIdentifier -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
PD.package PackageDescription
pkg_descr
distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
hpcdir :: Way -> Flag FilePath
hpcdir way :: Way
way
| Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way FilePath
pkg_name
| Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
libTargetDir
let cObjs :: [FilePath]
cObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) (BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
jsSrcs :: [FilePath]
jsSrcs = BuildInfo -> [FilePath]
jsSources BuildInfo
libBi
baseOpts :: GhcOptions
baseOpts = Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
libTargetDir
linkJsLibOpts :: GhcOptions
linkJsLibOpts = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptExtra :: [FilePath]
ghcOptExtra =
[ "-link-js-lib" , UnitId -> FilePath
getHSLibraryName UnitId
uid
, "-js-lib-outputdir", FilePath
libTargetDir ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath]
jsSrcs
}
vanillaOptsNoJsLib :: GhcOptions
vanillaOptsNoJsLib = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
}
vanillaOpts :: GhcOptions
vanillaOpts = GhcOptions
vanillaOptsNoJsLib GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkJsLibOpts
profOpts :: GhcOptions
profOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "p_hi" "p_o" GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
libBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
}
sharedOpts :: GhcOptions
sharedOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
libBi,
ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi,
ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
libBi,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles =
[FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cObjs] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
jsSrcs
}
replOpts :: GhcOptions
replOpts = GhcOptions
vanillaOptsNoJsLib {
ghcOptExtra :: [FilePath]
ghcOptExtra = [FilePath] -> [FilePath]
Internal.filterGhciFlags
(GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
vanillaOpts)
[FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
replFlags,
ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
forall a. Monoid a => a
mempty
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
}
vanillaSharedOpts :: GhcOptions
vanillaSharedOpts = GhcOptions
vanillaOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend`
GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
ghcOptDynHiSuffix :: Flag FilePath
ghcOptDynHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_hi",
ghcOptDynObjSuffix :: Flag FilePath
ghcOptDynObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_o",
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
forRepl Bool -> Bool -> Bool
|| ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi) Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
jsSrcs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cObjs)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do let vanilla :: IO ()
vanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
forceVanillaLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaOpts)
shared :: IO ()
shared = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
sharedOpts)
useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&&
(Bool
forceVanillaLib Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
(Bool
forceSharedLib Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi) Bool -> Bool -> Bool
&&
[FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi)
if Bool
useDynToo
then do
GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaSharedOpts
case (Way -> Flag FilePath
hpcdir Way
Hpc.Dyn, Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla) of
(Cabal.Flag dynDir :: FilePath
dynDir, Cabal.Flag vanillaDir :: FilePath
vanillaDir) -> do
Verbosity -> FilePath -> FilePath -> IO ()
copyDirectoryRecursive Verbosity
verbosity FilePath
dynDir FilePath
vanillaDir
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else if Bool
isGhcjsDynamic
then do IO ()
shared; IO ()
vanilla
else do IO ()
vanilla; IO ()
shared
IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
profOpts)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources BuildInfo
libBi) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
nativeToo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Building C Sources..."
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let vanillaCcOpts :: GhcOptions
vanillaCcOpts =
(Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo
LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi FilePath
libTargetDir FilePath
filename)
profCcOpts :: GhcOptions
profCcOpts = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "p_o"
}
sharedCcOpts :: GhcOptions
sharedCcOpts = GhcOptions
vanillaCcOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptFPic :: Flag Bool
ghcOptFPic = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag "dyn_o"
}
odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
vanillaCcOpts)
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
GhcOptions -> IO ()
runGhcjsProg GhcOptions
vanillaCcOpts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
forceSharedLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
sharedCcOpts)
IO () -> IO ()
whenProfLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
profCcOpts)
| FilePath
filename <- BuildInfo -> [FilePath]
cSources BuildInfo
libBi]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
ifReplLib (GhcOptions -> IO ()
runGhcjsProg GhcOptions
replOpts)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nativeToo Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
forRepl) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Linking..."
let cProfObjs :: [FilePath]
cProfObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` ("p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
(BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
cSharedObjs :: [FilePath]
cSharedObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` ("dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension))
(BuildInfo -> [FilePath]
cSources BuildInfo
libBi)
compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
vanillaLibFilePath :: FilePath
vanillaLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkLibName UnitId
uid
profileLibFilePath :: FilePath
profileLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
mkProfLibName UnitId
uid
sharedLibFilePath :: FilePath
sharedLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id UnitId
uid
ghciLibFilePath :: FilePath
ghciLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
ghciProfLibFilePath :: FilePath
ghciProfLibFilePath = FilePath
libTargetDir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid
[FilePath]
hObjs <- GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
FilePath
libTargetDir FilePath
objExtension Bool
True
[FilePath]
hProfObjs <-
if (LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
FilePath
libTargetDir ("p_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
True
else [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[FilePath]
hSharedObjs <-
if (LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
then GhcImplInfo
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> Bool
-> NoCallStackIO [FilePath]
Internal.getHaskellObjects GhcImplInfo
implInfo Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
FilePath
libTargetDir ("dyn_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
objExtension) Bool
False
else [FilePath] -> NoCallStackIO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
hObjs Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cObjs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let staticObjectFiles :: [FilePath]
staticObjectFiles =
[FilePath]
hObjs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cObjs
profObjectFiles :: [FilePath]
profObjectFiles =
[FilePath]
hProfObjs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cProfObjs
dynamicObjectFiles :: [FilePath]
dynamicObjectFiles =
[FilePath]
hSharedObjs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
libTargetDir FilePath -> FilePath -> FilePath
</>) [FilePath]
cSharedObjs
ghcSharedLinkArgs :: GhcOptions
ghcSharedLinkArgs =
GhcOptions
forall a. Monoid a => a
mempty {
ghcOptShared :: Flag Bool
ghcOptShared = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR [FilePath]
dynamicObjectFiles,
ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
sharedLibFilePath,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
libBi,
ghcOptNoAutoLinkPackages :: Flag Bool
ghcOptNoAutoLinkPackages = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = LocalBuildInfo -> [PackageDB]
withPackageDB LocalBuildInfo
lbi,
ghcOptPackages :: NubListR (OpenUnitId, ModuleRenaming)
ghcOptPackages = [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a. Ord a => [a] -> NubListR a
toNubListR ([(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming))
-> [(OpenUnitId, ModuleRenaming)]
-> NubListR (OpenUnitId, ModuleRenaming)
forall a b. (a -> b) -> a -> b
$
ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
Internal.mkGhcOptPackages ComponentLocalBuildInfo
clbi,
ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = BuildInfo -> [FilePath]
extraLibs BuildInfo
libBi,
ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
libBi
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenVanillaLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
vanillaLibFilePath [FilePath]
staticObjectFiles
IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ldProg :: ConfiguredProgram
ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
FilePath
ghciLibFilePath [FilePath]
staticObjectFiles
IO () -> IO ()
whenProfLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
Ar.createArLibArchive Verbosity
verbosity LocalBuildInfo
lbi FilePath
profileLibFilePath [FilePath]
profObjectFiles
IO () -> IO ()
whenGHCiLib (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ldProg :: ConfiguredProgram
ldProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ldProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
Verbosity
-> LocalBuildInfo
-> ConfiguredProgram
-> FilePath
-> [FilePath]
-> IO ()
Ld.combineObjectFiles Verbosity
verbosity LocalBuildInfo
lbi ConfiguredProgram
ldProg
FilePath
ghciProfLibFilePath [FilePath]
profObjectFiles
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenSharedLib Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcjsProg GhcOptions
ghcSharedLinkArgs
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
-> PackageDBStack -> IO ()
startInterpreter :: Verbosity
-> ProgramDb -> Compiler -> Platform -> [PackageDB] -> IO ()
startInterpreter verbosity :: Verbosity
verbosity progdb :: ProgramDb
progdb comp :: Compiler
comp platform :: Platform
platform packageDBs :: [PackageDB]
packageDBs = do
let replOpts :: GhcOptions
replOpts = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
ghcOptPackageDBs :: [PackageDB]
ghcOptPackageDBs = [PackageDB]
packageDBs
}
Verbosity -> [PackageDB] -> IO ()
checkPackageDbStack Verbosity
verbosity [PackageDB]
packageDBs
(ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram ProgramDb
progdb
Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform GhcOptions
replOpts
buildExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildExe = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe Maybe [FilePath]
forall a. Maybe a
Nothing
replExe :: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Executable
-> ComponentLocalBuildInfo -> IO ()
replExe :: [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
replExe = Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe (Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ())
-> ([FilePath] -> Maybe [FilePath])
-> [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just
buildOrReplExe :: Maybe [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Executable
-> ComponentLocalBuildInfo -> IO ()
buildOrReplExe :: Maybe [FilePath]
-> Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
buildOrReplExe mReplFlags :: Maybe [FilePath]
mReplFlags verbosity :: Verbosity
verbosity numJobs :: Flag (Maybe Int)
numJobs _pkg_descr :: PackageDescription
_pkg_descr lbi :: LocalBuildInfo
lbi
exe :: Executable
exe@Executable { exeName :: Executable -> UnqualComponentName
exeName = UnqualComponentName
exeName', modulePath :: Executable -> FilePath
modulePath = FilePath
modPath } clbi :: ComponentLocalBuildInfo
clbi = do
(ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
let forRepl :: Bool
forRepl = Bool -> ([FilePath] -> Bool) -> Maybe [FilePath] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> [FilePath] -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe [FilePath]
mReplFlags
replFlags :: [FilePath]
replFlags = [FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [FilePath]
forall a. Monoid a => a
mempty Maybe [FilePath]
mReplFlags
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
runGhcjsProg :: GhcOptions -> IO ()
runGhcjsProg = Verbosity
-> ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> IO ()
runGHC Verbosity
verbosity ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform
exeBi :: BuildInfo
exeBi = Executable -> BuildInfo
buildInfo Executable
exe
let exeName'' :: FilePath
exeName'' = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
exeName'
let exeNameReal :: FilePath
exeNameReal = FilePath
exeName'' FilePath -> FilePath -> FilePath
<.>
(if FilePath -> FilePath
takeExtension FilePath
exeName'' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= ('.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Platform -> FilePath
exeExtension Platform
buildPlatform)
then Platform -> FilePath
exeExtension Platform
buildPlatform
else "")
let targetDir :: FilePath
targetDir = (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi) FilePath -> FilePath -> FilePath
</> FilePath
exeName''
let exeDir :: FilePath
exeDir = FilePath
targetDir FilePath -> FilePath -> FilePath
</> (FilePath
exeName'' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-tmp")
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
targetDir
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
exeDir
let isCoverageEnabled :: Bool
isCoverageEnabled = LocalBuildInfo -> Bool
exeCoverage LocalBuildInfo
lbi
distPref :: FilePath
distPref = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag FilePath -> FilePath) -> Flag FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag FilePath
configDistPref (ConfigFlags -> Flag FilePath) -> ConfigFlags -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
hpcdir :: Way -> Flag FilePath
hpcdir way :: Way
way
| Bool
isCoverageEnabled = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath -> Flag FilePath) -> FilePath -> Flag FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Way -> FilePath -> FilePath
Hpc.mixDir FilePath
distPref Way
way FilePath
exeName''
| Bool
otherwise = Flag FilePath
forall a. Monoid a => a
mempty
FilePath
srcMainFile <- [FilePath] -> FilePath -> IO FilePath
findFile (FilePath
exeDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
exeBi) FilePath
modPath
let isGhcjsDynamic :: Bool
isGhcjsDynamic = Compiler -> Bool
isDynamic Compiler
comp
dynamicTooSupported :: Bool
dynamicTooSupported = Compiler -> Bool
supportsDynamicToo Compiler
comp
buildRunner :: Bool
buildRunner = case ComponentLocalBuildInfo
clbi of
LibComponentLocalBuildInfo {} -> Bool
False
FLibComponentLocalBuildInfo {} -> Bool
False
ExeComponentLocalBuildInfo {} -> Bool
True
TestComponentLocalBuildInfo {} -> Bool
True
BenchComponentLocalBuildInfo {} -> Bool
True
isHaskellMain :: Bool
isHaskellMain = FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeExtension FilePath
srcMainFile) [".hs", ".lhs"]
jsSrcs :: [FilePath]
jsSrcs = BuildInfo -> [FilePath]
jsSources BuildInfo
exeBi
cSrcs :: [FilePath]
cSrcs = BuildInfo -> [FilePath]
cSources BuildInfo
exeBi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
srcMainFile | Bool -> Bool
not Bool
isHaskellMain]
cObjs :: [FilePath]
cObjs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
objExtension) [FilePath]
cSrcs
nativeToo :: Bool
nativeToo = Compiler -> Bool
ghcjsNativeToo Compiler
comp
baseOpts :: GhcOptions
baseOpts = (Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
exeBi ComponentLocalBuildInfo
clbi FilePath
exeDir)
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeMake,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
[ FilePath
srcMainFile | Bool
isHaskellMain],
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$
[ ModuleName
m | Bool -> Bool
not Bool
isHaskellMain, ModuleName
m <- Executable -> [ModuleName]
exeModules Executable
exe],
ghcOptExtra :: [FilePath]
ghcOptExtra =
if Bool
buildRunner then ["-build-runner"]
else [FilePath]
forall a. Monoid a => a
mempty
}
staticOpts :: GhcOptions
staticOpts = GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticOnly,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Vanilla
}
profOpts :: GhcOptions
profOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "p_hi" "p_o" GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
exeBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Prof
}
dynOpts :: GhcOptions
dynOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
baseOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcDynamicOnly,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
exeBi,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
dynTooOpts :: GhcOptions
dynTooOpts = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "dyn_hi" "dyn_o" GhcOptions
staticOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag GhcDynLinkMode
GhcStaticAndDynamic,
ghcOptHPCDir :: Flag FilePath
ghcOptHPCDir = Way -> Flag FilePath
hpcdir Way
Hpc.Dyn
}
linkerOpts :: GhcOptions
linkerOpts = GhcOptions
forall a. Monoid a => a
mempty {
ghcOptLinkOptions :: [FilePath]
ghcOptLinkOptions = BuildInfo -> [FilePath]
PD.ldOptions BuildInfo
exeBi,
ghcOptLinkLibs :: [FilePath]
ghcOptLinkLibs = BuildInfo -> [FilePath]
extraLibs BuildInfo
exeBi,
ghcOptLinkLibPath :: NubListR FilePath
ghcOptLinkLibPath = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
extraLibDirs BuildInfo
exeBi,
ghcOptLinkFrameworks :: NubListR FilePath
ghcOptLinkFrameworks = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [FilePath]
PD.frameworks BuildInfo
exeBi,
ghcOptInputFiles :: NubListR FilePath
ghcOptInputFiles = [FilePath] -> NubListR FilePath
forall a. Ord a => [a] -> NubListR a
toNubListR ([FilePath] -> NubListR FilePath)
-> [FilePath] -> NubListR FilePath
forall a b. (a -> b) -> a -> b
$
[FilePath
exeDir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cObjs] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
jsSrcs
}
replOpts :: GhcOptions
replOpts = GhcOptions
baseOpts {
ghcOptExtra :: [FilePath]
ghcOptExtra = [FilePath] -> [FilePath]
Internal.filterGhciFlags
(GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
baseOpts)
[FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
replFlags
}
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
linkerOpts
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeInteractive,
ghcOptOptimisation :: Flag GhcOptimisation
ghcOptOptimisation = GhcOptimisation -> Flag GhcOptimisation
forall a. a -> Flag a
toFlag GhcOptimisation
GhcNoOptimisation
}
commonOpts :: GhcOptions
commonOpts | LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi = GhcOptions
profOpts
| LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
compileOpts :: GhcOptions
compileOpts | Bool
useDynToo = GhcOptions
dynTooOpts
| Bool
otherwise = GhcOptions
commonOpts
withStaticExe :: Bool
withStaticExe = (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi)
doingTH :: Bool
doingTH = BuildInfo -> Bool
usesTemplateHaskellOrQQ BuildInfo
exeBi
useDynToo :: Bool
useDynToo = Bool
dynamicTooSupported Bool -> Bool -> Bool
&& Bool
isGhcjsDynamic
Bool -> Bool -> Bool
&& Bool
doingTH Bool -> Bool -> Bool
&& Bool
withStaticExe Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
ghcjsSharedOptions BuildInfo
exeBi)
compileTHOpts :: GhcOptions
compileTHOpts | Bool
isGhcjsDynamic = GhcOptions
dynOpts
| Bool
otherwise = GhcOptions
staticOpts
compileForTH :: Bool
compileForTH
| Bool
forRepl = Bool
False
| Bool
useDynToo = Bool
False
| Bool
isGhcjsDynamic = Bool
doingTH Bool -> Bool -> Bool
&& (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi Bool -> Bool -> Bool
|| Bool
withStaticExe)
| Bool
otherwise = Bool
doingTH Bool -> Bool -> Bool
&& (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi Bool -> Bool -> Bool
|| LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi)
linkOpts :: GhcOptions
linkOpts = GhcOptions
commonOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend`
GhcOptions
linkerOpts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptLinkNoHsMain :: Flag Bool
ghcOptLinkNoHsMain = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (Bool -> Bool
not Bool
isHaskellMain)
}
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
compileForTH (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcjsProg GhcOptions
compileTHOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
, ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
GhcOptions -> IO ()
runGhcjsProg GhcOptions
compileOpts { ghcOptNoLink :: Flag Bool
ghcOptNoLink = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True
, ghcOptNumJobs :: Flag (Maybe Int)
ghcOptNumJobs = Flag (Maybe Int)
numJobs }
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cSrcs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
nativeToo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Building C Sources..."
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do let opts :: GhcOptions
opts = (Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
Internal.componentCcGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
exeBi
ComponentLocalBuildInfo
clbi FilePath
exeDir FilePath
filename) GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptDynLinkMode :: Flag GhcDynLinkMode
ghcOptDynLinkMode = GhcDynLinkMode -> Flag GhcDynLinkMode
forall a. a -> Flag a
toFlag (if LocalBuildInfo -> Bool
withDynExe LocalBuildInfo
lbi
then GhcDynLinkMode
GhcDynamicOnly
else GhcDynLinkMode
GhcStaticOnly),
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag (LocalBuildInfo -> Bool
withProfExe LocalBuildInfo
lbi)
}
odir :: FilePath
odir = Flag FilePath -> FilePath
forall a. WithCallStack (Flag a -> a)
fromFlag (GhcOptions -> Flag FilePath
ghcOptObjDir GhcOptions
opts)
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
odir
GhcOptions -> IO ()
runGhcjsProg GhcOptions
opts
| FilePath
filename <- [FilePath]
cSrcs ]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ GhcOptions -> IO ()
runGhcjsProg GhcOptions
replOpts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forRepl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity "Linking..."
GhcOptions -> IO ()
runGhcjsProg GhcOptions
linkOpts { ghcOptOutputFile :: Flag FilePath
ghcOptOutputFile = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
exeNameReal) }
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi targetDir :: FilePath
targetDir dynlibTargetDir :: FilePath
dynlibTargetDir builtDir :: FilePath
builtDir _pkg :: PackageDescription
_pkg lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_hi"
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_p_hi"
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "js_dyn_hi"
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
vanillaLibName
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinary FilePath
builtDir FilePath
targetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
profileLibName
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installShared FilePath
builtDir FilePath
dynlibTargetDir (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toJSLibName FilePath
sharedLibName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Compiler -> Bool
ghcjsNativeToo (Compiler -> Bool) -> Compiler -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "hi"
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "p_hi"
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
copyModuleFiles "dyn_hi"
IO () -> IO ()
whenVanilla (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
vanillaLibName
IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
ghciLibName
IO () -> IO ()
whenProf (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
profileLibName
IO () -> IO ()
whenGHCi (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative FilePath
builtDir FilePath
targetDir FilePath
ghciProfLibName
IO () -> IO ()
whenShared (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> IO ()
installSharedNative FilePath
builtDir FilePath
dynlibTargetDir FilePath
sharedLibName
where
install :: Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install isShared :: Bool
isShared isJS :: Bool
isJS srcDir :: FilePath
srcDir dstDir :: FilePath
dstDir name :: FilePath
name = do
let src :: FilePath
src = FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
name
dst :: FilePath
dst = FilePath
dstDir FilePath -> FilePath -> FilePath
</> FilePath
name
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
dstDir
if Bool
isShared
then Verbosity -> FilePath -> FilePath -> IO ()
installExecutableFile Verbosity
verbosity FilePath
src FilePath
dst
else Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verbosity FilePath
src FilePath
dst
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LocalBuildInfo -> Bool
stripLibs LocalBuildInfo
lbi Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isJS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> Platform -> ProgramDb -> FilePath -> IO ()
Strip.stripLib Verbosity
verbosity
(LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) FilePath
dst
installOrdinary :: FilePath -> FilePath -> FilePath -> IO ()
installOrdinary = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
False Bool
True
installShared :: FilePath -> FilePath -> FilePath -> IO ()
installShared = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
True Bool
True
installOrdinaryNative :: FilePath -> FilePath -> FilePath -> IO ()
installOrdinaryNative = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
False Bool
False
installSharedNative :: FilePath -> FilePath -> FilePath -> IO ()
installSharedNative = Bool -> Bool -> FilePath -> FilePath -> FilePath -> IO ()
install Bool
True Bool
False
copyModuleFiles :: FilePath -> IO ()
copyModuleFiles ext :: FilePath
ext =
[FilePath]
-> [FilePath] -> [ModuleName] -> IO [(FilePath, FilePath)]
findModuleFiles [FilePath
builtDir] [FilePath
ext] (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
IO [(FilePath, FilePath)]
-> ([(FilePath, FilePath)] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles Verbosity
verbosity FilePath
targetDir
compiler_id :: CompilerId
compiler_id = Compiler -> CompilerId
compilerId (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
vanillaLibName :: FilePath
vanillaLibName = UnitId -> FilePath
mkLibName UnitId
uid
profileLibName :: FilePath
profileLibName = UnitId -> FilePath
mkProfLibName UnitId
uid
ghciLibName :: FilePath
ghciLibName = UnitId -> FilePath
Internal.mkGHCiLibName UnitId
uid
ghciProfLibName :: FilePath
ghciProfLibName = UnitId -> FilePath
Internal.mkGHCiProfLibName UnitId
uid
sharedLibName :: FilePath
sharedLibName = (Platform -> CompilerId -> UnitId -> FilePath
mkSharedLibName (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) CompilerId
compiler_id) UnitId
uid
hasLib :: Bool
hasLib = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
Bool -> Bool -> Bool
&& [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
cSources (Library -> BuildInfo
libBuildInfo Library
lib))
whenVanilla :: IO () -> IO ()
whenVanilla = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi)
whenProf :: IO () -> IO ()
whenProf = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi)
whenGHCi :: IO () -> IO ()
whenGHCi = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withGHCiLib LocalBuildInfo
lbi)
whenShared :: IO () -> IO ()
whenShared = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLib Bool -> Bool -> Bool
&& LocalBuildInfo -> Bool
withSharedLib LocalBuildInfo
lbi)
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi binDir :: FilePath
binDir buildPref :: FilePath
buildPref
(progprefix :: FilePath
progprefix, progsuffix :: FilePath
progsuffix) _pkg :: PackageDescription
_pkg exe :: Executable
exe = do
Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
binDir
let exeName' :: FilePath
exeName' = UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
exe
exeFileName :: FilePath
exeFileName = FilePath
exeName'
fixedExeBaseName :: FilePath
fixedExeBaseName = FilePath
progprefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
exeName' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
progsuffix
installBinary :: FilePath -> IO ()
installBinary dest :: FilePath
dest = do
Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ "--install-executable"
, FilePath
buildPref FilePath -> FilePath -> FilePath
</> FilePath
exeName' FilePath -> FilePath -> FilePath
</> FilePath
exeFileName
, "-o", FilePath
dest
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
case (LocalBuildInfo -> Bool
stripExes LocalBuildInfo
lbi, Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
stripProgram (ProgramDb -> Maybe ConfiguredProgram)
-> ProgramDb -> Maybe ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) of
(True, Just strip :: ConfiguredProgram
strip) -> ["-strip-program", ConfiguredProgram -> FilePath
programPath ConfiguredProgram
strip]
_ -> []
FilePath -> IO ()
installBinary (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fixedExeBaseName)
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
libAbiHash verbosity :: Verbosity
verbosity _pkg_descr :: PackageDescription
_pkg_descr lbi :: LocalBuildInfo
lbi lib :: Library
lib clbi :: ComponentLocalBuildInfo
clbi = do
let
libBi :: BuildInfo
libBi = Library -> BuildInfo
libBuildInfo Library
lib
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
platform :: Platform
platform = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi
vanillaArgs :: GhcOptions
vanillaArgs =
(Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions Verbosity
verbosity LocalBuildInfo
lbi BuildInfo
libBi ComponentLocalBuildInfo
clbi (LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi))
GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptMode :: Flag GhcMode
ghcOptMode = GhcMode -> Flag GhcMode
forall a. a -> Flag a
toFlag GhcMode
GhcModeAbiHash,
ghcOptInputModules :: NubListR ModuleName
ghcOptInputModules = [ModuleName] -> NubListR ModuleName
forall a. Ord a => [a] -> NubListR a
toNubListR ([ModuleName] -> NubListR ModuleName)
-> [ModuleName] -> NubListR ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
PD.exposedModules Library
lib
}
profArgs :: GhcOptions
profArgs = FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts "js_p_hi" "js_p_o" GhcOptions
vanillaArgs GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptProfilingMode :: Flag Bool
ghcOptProfilingMode = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
True,
ghcOptExtra :: [FilePath]
ghcOptExtra = BuildInfo -> [FilePath]
ghcjsProfOptions BuildInfo
libBi
}
ghcArgs :: GhcOptions
ghcArgs | LocalBuildInfo -> Bool
withVanillaLib LocalBuildInfo
lbi = GhcOptions
vanillaArgs
| LocalBuildInfo -> Bool
withProfLib LocalBuildInfo
lbi = GhcOptions
profArgs
| Bool
otherwise = FilePath -> GhcOptions
forall a. HasCallStack => FilePath -> a
error "libAbiHash: Can't find an enabled library way"
(ghcjsProg :: ConfiguredProgram
ghcjsProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcjsProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
FilePath
hash <- Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput Verbosity
verbosity
(ConfiguredProgram
-> Compiler -> Platform -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram
ghcjsProg Compiler
comp Platform
platform GhcOptions
ghcArgs)
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) FilePath
hash)
adjustExts :: String -> String -> GhcOptions -> GhcOptions
adjustExts :: FilePath -> FilePath -> GhcOptions -> GhcOptions
adjustExts hiSuf :: FilePath
hiSuf objSuf :: FilePath
objSuf opts :: GhcOptions
opts =
GhcOptions
opts GhcOptions -> GhcOptions -> GhcOptions
forall a. Monoid a => a -> a -> a
`mappend` GhcOptions
forall a. Monoid a => a
mempty {
ghcOptHiSuffix :: Flag FilePath
ghcOptHiSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
hiSuf,
ghcOptObjSuffix :: Flag FilePath
ghcOptObjSuffix = FilePath -> Flag FilePath
forall a. a -> Flag a
toFlag FilePath
objSuf
}
registerPackage :: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage :: Verbosity
-> ProgramDb
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage verbosity :: Verbosity
verbosity progdb :: ProgramDb
progdb packageDbs :: [PackageDB]
packageDbs installedPkgInfo :: InstalledPackageInfo
installedPkgInfo registerOptions :: RegisterOptions
registerOptions =
HcPkgInfo
-> Verbosity
-> [PackageDB]
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
HcPkg.register (ProgramDb -> HcPkgInfo
hcPkgInfo ProgramDb
progdb) Verbosity
verbosity [PackageDB]
packageDbs
InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions :: Verbosity
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
componentGhcOptions verbosity :: Verbosity
verbosity lbi :: LocalBuildInfo
lbi bi :: BuildInfo
bi clbi :: ComponentLocalBuildInfo
clbi odir :: FilePath
odir =
let opts :: GhcOptions
opts = Verbosity
-> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
Internal.componentGhcOptions Verbosity
verbosity GhcImplInfo
implInfo LocalBuildInfo
lbi BuildInfo
bi ComponentLocalBuildInfo
clbi FilePath
odir
comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
implInfo :: GhcImplInfo
implInfo = Compiler -> GhcImplInfo
getImplInfo Compiler
comp
in GhcOptions
opts { ghcOptExtra :: [FilePath]
ghcOptExtra = GhcOptions -> [FilePath]
ghcOptExtra GhcOptions
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcOptions CompilerFlavor
GHCJS BuildInfo
bi
}
ghcjsProfOptions :: BuildInfo -> [String]
ghcjsProfOptions :: BuildInfo -> [FilePath]
ghcjsProfOptions bi :: BuildInfo
bi =
CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHC BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcProfOptions CompilerFlavor
GHCJS BuildInfo
bi
ghcjsSharedOptions :: BuildInfo -> [String]
ghcjsSharedOptions :: BuildInfo -> [FilePath]
ghcjsSharedOptions bi :: BuildInfo
bi =
CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHC BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` CompilerFlavor -> BuildInfo -> [FilePath]
hcSharedOptions CompilerFlavor
GHCJS BuildInfo
bi
isDynamic :: Compiler -> Bool
isDynamic :: Compiler -> Bool
isDynamic = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = FilePath -> Compiler -> Bool
Internal.ghcLookupProperty "Support dynamic-too"
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsGhcVersion verbosity :: Verbosity
verbosity pgm :: FilePath
pgm =
FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion "--numeric-ghc-version" FilePath -> FilePath
forall a. a -> a
id Verbosity
verbosity FilePath
pgm
findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
findGhcjsPkgGhcjsVersion verbosity :: Verbosity
verbosity pgm :: FilePath
pgm =
FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion "--numeric-ghcjs-version" FilePath -> FilePath
forall a. a -> a
id Verbosity
verbosity FilePath
pgm
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo :: ProgramDb -> HcPkgInfo
hcPkgInfo progdb :: ProgramDb
progdb = HcPkgInfo :: ConfiguredProgram
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> HcPkgInfo
HcPkg.HcPkgInfo { hcPkgProgram :: ConfiguredProgram
HcPkg.hcPkgProgram = ConfiguredProgram
ghcjsPkgProg
, noPkgDbStack :: Bool
HcPkg.noPkgDbStack = Bool
False
, noVerboseFlag :: Bool
HcPkg.noVerboseFlag = Bool
False
, flagPackageConf :: Bool
HcPkg.flagPackageConf = Bool
False
, supportsDirDbs :: Bool
HcPkg.supportsDirDbs = Bool
True
, requiresDirDbs :: Bool
HcPkg.requiresDirDbs = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
, nativeMultiInstance :: Bool
HcPkg.nativeMultiInstance = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v7_10
, recacheMultiInstance :: Bool
HcPkg.recacheMultiInstance = Bool
True
, suppressFilesCheck :: Bool
HcPkg.suppressFilesCheck = Bool
True
}
where
v7_10 :: Version
v7_10 = [Int] -> Version
mkVersion [7,10]
Just ghcjsPkgProg :: ConfiguredProgram
ghcjsPkgProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsPkgProgram ProgramDb
progdb
Just ver :: Version
ver = ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
ghcjsPkgProg
runCmd :: ProgramDb -> FilePath
-> (FilePath, FilePath, [String])
runCmd :: ProgramDb -> FilePath -> (FilePath, FilePath, [FilePath])
runCmd progdb :: ProgramDb
progdb exe :: FilePath
exe =
( FilePath
script
, ConfiguredProgram -> FilePath
programPath ConfiguredProgram
ghcjsProg
, ConfiguredProgram -> [FilePath]
programDefaultArgs ConfiguredProgram
ghcjsProg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [FilePath]
programOverrideArgs ConfiguredProgram
ghcjsProg [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["--run"]
)
where
script :: FilePath
script = FilePath
exe FilePath -> FilePath -> FilePath
<.> "jsexe" FilePath -> FilePath -> FilePath
</> "all" FilePath -> FilePath -> FilePath
<.> "js"
Just ghcjsProg :: ConfiguredProgram
ghcjsProg = Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
ghcjsProgram ProgramDb
progdb