content: {-# 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.Text
  import Distribution.Types.UnitId
  import Language.Haskell.Extension
  
  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 hcPath hcPkgPath progdb0 = do
    (ghcjsProg, ghcjsVersion, progdb1) <-
      requireProgramVersion verbosity ghcjsProgram
        (orLaterVersion (mkVersion [0,1]))
        (userMaybeSpecifyPath "ghcjs" hcPath progdb0)
    Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg)
    let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion
  
    -- This is slightly tricky, we have to configure ghcjs first, then we use the
    -- location of ghcjs to help find ghcjs-pkg in the case that the user did not
    -- specify the location of ghc-pkg directly:
    (ghcjsPkgProg, ghcjsPkgVersion, progdb2) <-
      requireProgramVersion verbosity ghcjsPkgProgram {
        programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg
      }
      anyVersion (userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath progdb1)
  
    Just ghcjsPkgGhcjsVersion <- findGhcjsPkgGhcjsVersion
                                    verbosity (programPath ghcjsPkgProg)
  
    when (ghcjsVersion /= ghcjsPkgGhcjsVersion) $ die' verbosity $
         "Version mismatch between ghcjs and ghcjs-pkg: "
      ++ programPath ghcjsProg ++ " is version " ++ display ghcjsVersion ++ " "
      ++ programPath ghcjsPkgProg ++ " is version " ++ display ghcjsPkgGhcjsVersion
  
    when (ghcjsGhcVersion /= ghcjsPkgVersion) $ die' verbosity $
         "Version mismatch between ghcjs and ghcjs-pkg: "
      ++ programPath ghcjsProg
      ++ " was built with GHC version " ++ display ghcjsGhcVersion ++ " "
      ++ programPath ghcjsPkgProg
      ++ " was built with GHC version " ++ display ghcjsPkgVersion
  
    -- be sure to use our versions of hsc2hs, c2hs, haddock and ghc
    let hsc2hsProgram' =
          hsc2hsProgram { programFindLocation =
                            guessHsc2hsFromGhcjsPath ghcjsProg }
        c2hsProgram' =
          c2hsProgram { programFindLocation =
                            guessC2hsFromGhcjsPath ghcjsProg }
  
        haddockProgram' =
          haddockProgram { programFindLocation =
                            guessHaddockFromGhcjsPath ghcjsProg }
        progdb3 = addKnownPrograms [ hsc2hsProgram', c2hsProgram', haddockProgram' ] progdb2
  
    languages  <- Internal.getLanguages  verbosity implInfo ghcjsProg
    extensions <- Internal.getExtensions verbosity implInfo ghcjsProg
  
    ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg
    let ghcInfoMap = Map.fromList ghcInfo
  
    let comp = Compiler {
          compilerId         = CompilerId GHCJS ghcjsVersion,
          compilerAbiTag     = AbiTag $
            "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion),
          compilerCompat     = [CompilerId GHC ghcjsGhcVersion],
          compilerLanguages  = languages,
          compilerExtensions = extensions,
          compilerProperties = ghcInfoMap
        }
        compPlatform = Internal.targetPlatform ghcInfo
    -- configure gcc and ld
    let progdb4 = if ghcjsNativeToo comp
                       then Internal.configureToolchain implInfo
                              ghcjsProg ghcInfoMap progdb3
                       else progdb3
    return (comp, compPlatform, progdb4)
  
  ghcjsNativeToo :: Compiler -> Bool
  ghcjsNativeToo = Internal.ghcLookupProperty "Native Too"
  
  guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity
                             -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
  guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram
  
  guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
                           -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
  guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram
  
  guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity
                         -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
  guessC2hsFromGhcjsPath = guessToolFromGhcjsPath c2hsProgram
  
  guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity
                            -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
  guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram
  
  guessToolFromGhcjsPath :: Program -> ConfiguredProgram
                         -> Verbosity -> ProgramSearchPath
                         -> IO (Maybe (FilePath, [FilePath]))
  guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath
    = do let toolname          = programName tool
             path              = programPath ghcjsProg
             dir               = takeDirectory path
             versionSuffix     = takeVersionSuffix (dropExeExtension path)
             guessNormal       = dir </> toolname <.> exeExtension
             guessGhcjsVersioned = dir </> (toolname ++ "-ghcjs" ++ versionSuffix)
                                   <.> exeExtension
             guessGhcjs        = dir </> (toolname ++ "-ghcjs")
                                 <.> exeExtension
             guessVersioned    = dir </> (toolname ++ versionSuffix) <.> exeExtension
             guesses | null versionSuffix = [guessGhcjs, guessNormal]
                     | otherwise          = [guessGhcjsVersioned,
                                             guessGhcjs,
                                             guessVersioned,
                                             guessNormal]
         info verbosity $ "looking for tool " ++ toolname
           ++ " near compiler in " ++ dir
         exists <- traverse doesFileExist guesses
         case [ file | (file, True) <- zip guesses exists ] of
                     -- If we can't find it near ghc, fall back to the usual
                     -- method.
           []     -> programFindLocation tool verbosity searchpath
           (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
                        let lookedAt = map fst
                                     . takeWhile (\(_file, exist) -> not exist)
                                     $ zip guesses exists
                        return (Just (fp, lookedAt))
  
    where takeVersionSuffix :: FilePath -> String
          takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") .
                              reverse
  
  -- | Given a single package DB, return all installed packages.
  getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
                       -> IO InstalledPackageIndex
  getPackageDBContents verbosity packagedb progdb = do
    pkgss <- getInstalledPackages' verbosity [packagedb] progdb
    toPackageIndex verbosity pkgss progdb
  
  -- | Given a package DB stack, return all installed packages.
  getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
                       -> IO InstalledPackageIndex
  getInstalledPackages verbosity packagedbs progdb = do
    checkPackageDbEnvVar verbosity
    checkPackageDbStack verbosity packagedbs
    pkgss <- getInstalledPackages' verbosity packagedbs progdb
    index <- toPackageIndex verbosity pkgss progdb
    return $! index
  
  toPackageIndex :: Verbosity
                 -> [(PackageDB, [InstalledPackageInfo])]
                 -> ProgramDb
                 -> IO InstalledPackageIndex
  toPackageIndex verbosity pkgss progdb = do
    -- On Windows, various fields have $topdir/foo rather than full
    -- paths. We need to substitute the right value in so that when
    -- we, for example, call gcc, we have proper paths to give it.
    topDir <- getLibDir' verbosity ghcjsProg
    let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
                  | (_, pkgs) <- pkgss ]
    return $! (mconcat indices)
  
    where
      Just ghcjsProg = lookupProgram ghcjsProgram progdb
  
  checkPackageDbEnvVar :: Verbosity -> IO ()
  checkPackageDbEnvVar verbosity =
      Internal.checkPackageDbEnvVar verbosity "GHCJS" "GHCJS_PACKAGE_PATH"
  
  checkPackageDbStack :: Verbosity -> PackageDBStack -> IO ()
  checkPackageDbStack _ (GlobalPackageDB:rest)
    | GlobalPackageDB `notElem` rest = return ()
  checkPackageDbStack verbosity rest
    | GlobalPackageDB `notElem` rest =
    die' verbosity $ "With current ghc versions the global package db is always used "
       ++ "and must be listed first. This ghc limitation may be lifted in "
       ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977"
  checkPackageDbStack verbosity _ =
    die' verbosity $ "If the global package db is specified, it must be "
       ++ "specified first and cannot be specified multiple times"
  
  getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
                        -> IO [(PackageDB, [InstalledPackageInfo])]
  getInstalledPackages' verbosity packagedbs progdb =
    sequenceA
      [ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
           return (packagedb, pkgs)
      | packagedb <- packagedbs ]
  
  getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
  getLibDir verbosity lbi =
      (reverse . dropWhile isSpace . reverse) `fmap`
       getDbProgramOutput verbosity ghcjsProgram
       (withPrograms lbi) ["--print-libdir"]
  
  getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
  getLibDir' verbosity ghcjsProg =
      (reverse . dropWhile isSpace . reverse) `fmap`
       getProgramOutput verbosity ghcjsProg ["--print-libdir"]
  
  -- | Return the 'FilePath' to the global GHC package database.
  getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
  getGlobalPackageDB verbosity ghcjsProg =
      (reverse . dropWhile isSpace . reverse) `fmap`
       getProgramOutput verbosity ghcjsProg ["--print-global-package-db"]
  
  toJSLibName :: String -> String
  toJSLibName lib
    | takeExtension lib `elem` [".dll",".dylib",".so"]
                                = replaceExtension lib "js_so"
    | takeExtension lib == ".a" = replaceExtension lib "js_a"
    | otherwise                 = lib <.> "js_a"
  
  buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription
                    -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
                    -> IO ()
  buildLib = buildOrReplLib False
  replLib  = buildOrReplLib True
  
  buildOrReplLib :: Bool -> Verbosity  -> Cabal.Flag (Maybe Int)
                 -> PackageDescription -> LocalBuildInfo
                 -> Library            -> ComponentLocalBuildInfo -> IO ()
  buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
    let uid = componentUnitId clbi
        libTargetDir = buildDir lbi
        whenVanillaLib forceVanilla =
          when (not forRepl && (forceVanilla || withVanillaLib lbi))
        whenProfLib = when (not forRepl && withProfLib lbi)
        whenSharedLib forceShared =
          when (not forRepl &&  (forceShared || withSharedLib lbi))
        whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi)
        ifReplLib = when forRepl
        comp      = compiler lbi
        platform  = hostPlatform lbi
        implInfo  = getImplInfo comp
        nativeToo = ghcjsNativeToo comp
  
    (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
    let runGhcjsProg        = runGHC verbosity ghcjsProg comp platform
        libBi               = libBuildInfo lib
        isGhcjsDynamic      = isDynamic comp
        dynamicTooSupported = supportsDynamicToo comp
        doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
        forceVanillaLib = doingTH && not isGhcjsDynamic
        forceSharedLib  = doingTH &&     isGhcjsDynamic
        -- TH always needs default libs, even when building for profiling
  
    -- Determine if program coverage should be enabled and if so, what
    -- '-hpcdir' should be.
    let isCoverageEnabled = libCoverage lbi
        pkg_name = display $ PD.package pkg_descr
        distPref = fromFlag $ configDistPref $ configFlags lbi
        hpcdir way
          | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
          | otherwise = mempty
  
    createDirectoryIfMissingVerbose verbosity True libTargetDir
    -- TODO: do we need to put hs-boot files into place for mutually recursive
    -- modules?
    let cObjs       = map (`replaceExtension` objExtension) (cSources libBi)
        jsSrcs      = jsSources libBi
        baseOpts    = componentGhcOptions verbosity lbi libBi clbi libTargetDir
        linkJsLibOpts = mempty {
                          ghcOptExtra = toNubListR $
                            [ "-link-js-lib"     , getHSLibraryName uid
                            , "-js-lib-outputdir", libTargetDir ] ++
                            concatMap (\x -> ["-js-lib-src",x]) jsSrcs
                        }
        vanillaOptsNoJsLib = baseOpts `mappend` mempty {
                        ghcOptMode         = toFlag GhcModeMake,
                        ghcOptNumJobs      = numJobs,
                        ghcOptInputModules = toNubListR $ allLibModules lib clbi,
                        ghcOptHPCDir       = hpcdir Hpc.Vanilla
                      }
        vanillaOpts = vanillaOptsNoJsLib `mappend` linkJsLibOpts
  
        profOpts    = adjustExts "p_hi" "p_o" vanillaOpts `mappend` mempty {
                          ghcOptProfilingMode = toFlag True,
                          ghcOptExtra         = toNubListR $
                                                ghcjsProfOptions libBi,
                          ghcOptHPCDir        = hpcdir Hpc.Prof
                        }
        sharedOpts  = adjustExts "dyn_hi" "dyn_o" vanillaOpts `mappend` mempty {
                          ghcOptDynLinkMode = toFlag GhcDynamicOnly,
                          ghcOptFPic        = toFlag True,
                          ghcOptExtra       = toNubListR $
                                              ghcjsSharedOptions libBi,
                          ghcOptHPCDir      = hpcdir Hpc.Dyn
                        }
        linkerOpts = mempty {
                        ghcOptLinkOptions    = toNubListR $ PD.ldOptions libBi,
                        ghcOptLinkLibs       = toNubListR $ extraLibs libBi,
                        ghcOptLinkLibPath    = toNubListR $ extraLibDirs libBi,
                        ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
                        ghcOptInputFiles     =
                          toNubListR $ [libTargetDir </> x | x <- cObjs] ++ jsSrcs
                     }
        replOpts    = vanillaOptsNoJsLib {
                        ghcOptExtra        = overNubListR
                                             Internal.filterGhciFlags
                                             (ghcOptExtra vanillaOpts),
                        ghcOptNumJobs      = mempty
                      }
                      `mappend` linkerOpts
                      `mappend` mempty {
                        ghcOptMode         = toFlag GhcModeInteractive,
                        ghcOptOptimisation = toFlag GhcNoOptimisation
                      }
  
        vanillaSharedOpts = vanillaOpts `mappend`
                              mempty {
                                ghcOptDynLinkMode  = toFlag GhcStaticAndDynamic,
                                ghcOptDynHiSuffix  = toFlag "dyn_hi",
                                ghcOptDynObjSuffix = toFlag "dyn_o",
                                ghcOptHPCDir       = hpcdir Hpc.Dyn
                              }
  
    unless (forRepl || (null (allLibModules lib clbi) && null jsSrcs && null cObjs)) $
      do let vanilla = whenVanillaLib forceVanillaLib (runGhcjsProg vanillaOpts)
             shared  = whenSharedLib  forceSharedLib  (runGhcjsProg sharedOpts)
             useDynToo = dynamicTooSupported &&
                         (forceVanillaLib || withVanillaLib lbi) &&
                         (forceSharedLib  || withSharedLib  lbi) &&
                         null (ghcjsSharedOptions libBi)
         if useDynToo
            then do
                runGhcjsProg vanillaSharedOpts
                case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
                  (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do
                      -- When the vanilla and shared library builds are done
                      -- in one pass, only one set of HPC module interfaces
                      -- are generated. This set should suffice for both
                      -- static and dynamically linked executables. We copy
                      -- the modules interfaces so they are available under
                      -- both ways.
                      copyDirectoryRecursive verbosity dynDir vanillaDir
                  _ -> return ()
            else if isGhcjsDynamic
              then do shared;  vanilla
              else do vanilla; shared
         whenProfLib (runGhcjsProg profOpts)
  
    -- build any C sources
    unless (null (cSources libBi) || not nativeToo) $ do
       info verbosity "Building C Sources..."
       sequence_
         [ do let vanillaCcOpts =
                    (Internal.componentCcGhcOptions verbosity implInfo
                       lbi libBi clbi libTargetDir filename)
                  profCcOpts    = vanillaCcOpts `mappend` mempty {
                                    ghcOptProfilingMode = toFlag True,
                                    ghcOptObjSuffix     = toFlag "p_o"
                                  }
                  sharedCcOpts  = vanillaCcOpts `mappend` mempty {
                                    ghcOptFPic        = toFlag True,
                                    ghcOptDynLinkMode = toFlag GhcDynamicOnly,
                                    ghcOptObjSuffix   = toFlag "dyn_o"
                                  }
                  odir          = fromFlag (ghcOptObjDir vanillaCcOpts)
              createDirectoryIfMissingVerbose verbosity True odir
              runGhcjsProg vanillaCcOpts
              whenSharedLib forceSharedLib (runGhcjsProg sharedCcOpts)
              whenProfLib (runGhcjsProg profCcOpts)
         | filename <- cSources libBi]
  
    -- TODO: problem here is we need the .c files built first, so we can load them
    -- with ghci, but .c files can depend on .h files generated by ghc by ffi
    -- exports.
    unless (null (allLibModules lib clbi)) $
       ifReplLib (runGhcjsProg replOpts)
  
    -- link:
    when (nativeToo && not forRepl) $ do
      info verbosity "Linking..."
      let cProfObjs   = map (`replaceExtension` ("p_" ++ objExtension))
                        (cSources libBi)
          cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
                        (cSources libBi)
          compiler_id = compilerId (compiler lbi)
          vanillaLibFilePath = libTargetDir </> mkLibName            uid
          profileLibFilePath = libTargetDir </> mkProfLibName        uid
          sharedLibFilePath  = libTargetDir </> mkSharedLibName compiler_id uid
          ghciLibFilePath    = libTargetDir </> Internal.mkGHCiLibName uid
  
      hObjs     <- Internal.getHaskellObjects implInfo lib lbi clbi
                        libTargetDir objExtension True
      hProfObjs <-
        if (withProfLib lbi)
                then Internal.getHaskellObjects implInfo lib lbi clbi
                        libTargetDir ("p_" ++ objExtension) True
                else return []
      hSharedObjs <-
        if (withSharedLib lbi)
                then Internal.getHaskellObjects implInfo lib lbi clbi
                        libTargetDir ("dyn_" ++ objExtension) False
                else return []
  
      unless (null hObjs && null cObjs) $ do
  
        let staticObjectFiles =
                   hObjs
                ++ map (libTargetDir </>) cObjs
            profObjectFiles =
                   hProfObjs
                ++ map (libTargetDir </>) cProfObjs
            ghciObjFiles =
                   hObjs
                ++ map (libTargetDir </>) cObjs
            dynamicObjectFiles =
                   hSharedObjs
                ++ map (libTargetDir </>) cSharedObjs
            -- After the relocation lib is created we invoke ghc -shared
            -- with the dependencies spelled out as -package arguments
            -- and ghc invokes the linker with the proper library paths
            ghcSharedLinkArgs =
                mempty {
                  ghcOptShared             = toFlag True,
                  ghcOptDynLinkMode        = toFlag GhcDynamicOnly,
                  ghcOptInputFiles         = toNubListR dynamicObjectFiles,
                  ghcOptOutputFile         = toFlag sharedLibFilePath,
                  ghcOptExtra              = toNubListR $
                                             ghcjsSharedOptions libBi,
                  ghcOptNoAutoLinkPackages = toFlag True,
                  ghcOptPackageDBs         = withPackageDB lbi,
                  ghcOptPackages           = toNubListR $
                                             Internal.mkGhcOptPackages clbi,
                  ghcOptLinkLibs           = toNubListR $ extraLibs libBi,
                  ghcOptLinkLibPath        = toNubListR $ extraLibDirs libBi
                }
  
        whenVanillaLib False $ do
          Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
  
        whenProfLib $ do
          Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
  
        whenGHCiLib $ do
          (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
          Ld.combineObjectFiles verbosity ldProg
            ghciLibFilePath ghciObjFiles
  
        whenSharedLib False $
          runGhcjsProg ghcSharedLinkArgs
  
  -- | Start a REPL without loading any source files.
  startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
                   -> PackageDBStack -> IO ()
  startInterpreter verbosity progdb comp platform packageDBs = do
    let replOpts = mempty {
          ghcOptMode       = toFlag GhcModeInteractive,
          ghcOptPackageDBs = packageDBs
          }
    checkPackageDbStack verbosity packageDBs
    (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram progdb
    runGHC verbosity ghcjsProg comp platform replOpts
  
  buildExe, replExe :: Verbosity          -> Cabal.Flag (Maybe Int)
                    -> PackageDescription -> LocalBuildInfo
                    -> Executable         -> ComponentLocalBuildInfo -> IO ()
  buildExe = buildOrReplExe False
  replExe  = buildOrReplExe True
  
  buildOrReplExe :: Bool -> Verbosity  -> Cabal.Flag (Maybe Int)
                 -> PackageDescription -> LocalBuildInfo
                 -> Executable         -> ComponentLocalBuildInfo -> IO ()
  buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
    exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
  
    (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
    let comp         = compiler lbi
        platform     = hostPlatform lbi
        implInfo     = getImplInfo comp
        runGhcjsProg = runGHC verbosity ghcjsProg comp platform
        exeBi        = buildInfo exe
  
    let exeName'' = unUnqualComponentName exeName'
    -- exeNameReal, the name that GHC really uses (with .exe on Windows)
    let exeNameReal = exeName'' <.>
                      (if takeExtension exeName'' /= ('.':exeExtension)
                         then exeExtension
                         else "")
  
    let targetDir = (buildDir lbi) </> exeName''
    let exeDir    = targetDir </> (exeName'' ++ "-tmp")
    createDirectoryIfMissingVerbose verbosity True targetDir
    createDirectoryIfMissingVerbose verbosity True exeDir
    -- TODO: do we need to put hs-boot files into place for mutually recursive
    -- modules?  FIX: what about exeName.hi-boot?
  
    -- Determine if program coverage should be enabled and if so, what
    -- '-hpcdir' should be.
    let isCoverageEnabled = exeCoverage lbi
        distPref = fromFlag $ configDistPref $ configFlags lbi
        hpcdir way
          | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName''
          | otherwise = mempty
  
    -- build executables
  
    srcMainFile         <- findFile (exeDir : hsSourceDirs exeBi) modPath
    let isGhcjsDynamic      = isDynamic comp
        dynamicTooSupported = supportsDynamicToo comp
        buildRunner = case clbi of
                         ExeComponentLocalBuildInfo {} -> False
                         _                             -> True
        isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
        jsSrcs        = jsSources exeBi
        cSrcs         = cSources exeBi ++ [srcMainFile | not isHaskellMain]
        cObjs         = map (`replaceExtension` objExtension) cSrcs
        nativeToo     = ghcjsNativeToo comp
        baseOpts   = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
                      `mappend` mempty {
                        ghcOptMode         = toFlag GhcModeMake,
                        ghcOptInputFiles   = toNubListR $
                          [ srcMainFile | isHaskellMain],
                        ghcOptInputModules = toNubListR $
                          [ m | not isHaskellMain, m <- exeModules exe],
                        ghcOptExtra =
                          if buildRunner then toNubListR ["-build-runner"]
                                         else mempty
                      }
        staticOpts = baseOpts `mappend` mempty {
                        ghcOptDynLinkMode    = toFlag GhcStaticOnly,
                        ghcOptHPCDir         = hpcdir Hpc.Vanilla
                     }
        profOpts   = adjustExts "p_hi" "p_o" baseOpts `mappend` mempty {
                        ghcOptProfilingMode  = toFlag True,
                        ghcOptExtra          = toNubListR $ ghcjsProfOptions exeBi,
                        ghcOptHPCDir         = hpcdir Hpc.Prof
                      }
        dynOpts    = adjustExts "dyn_hi" "dyn_o" baseOpts `mappend` mempty {
                        ghcOptDynLinkMode    = toFlag GhcDynamicOnly,
                        ghcOptExtra          = toNubListR $
                                               ghcjsSharedOptions exeBi,
                        ghcOptHPCDir         = hpcdir Hpc.Dyn
                      }
        dynTooOpts = adjustExts "dyn_hi" "dyn_o" staticOpts `mappend` mempty {
                        ghcOptDynLinkMode    = toFlag GhcStaticAndDynamic,
                        ghcOptHPCDir         = hpcdir Hpc.Dyn
                      }
        linkerOpts = mempty {
                        ghcOptLinkOptions    = toNubListR $ PD.ldOptions exeBi,
                        ghcOptLinkLibs       = toNubListR $ extraLibs exeBi,
                        ghcOptLinkLibPath    = toNubListR $ extraLibDirs exeBi,
                        ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
                        ghcOptInputFiles     = toNubListR $
                                               [exeDir </> x | x <- cObjs] ++ jsSrcs
                     }
        replOpts   = baseOpts {
                        ghcOptExtra          = overNubListR
                                               Internal.filterGhciFlags
                                               (ghcOptExtra baseOpts)
                     }
                     -- For a normal compile we do separate invocations of ghc for
                     -- compiling as for linking. But for repl we have to do just
                     -- the one invocation, so that one has to include all the
                     -- linker stuff too, like -l flags and any .o files from C
                     -- files etc.
                     `mappend` linkerOpts
                     `mappend` mempty {
                        ghcOptMode           = toFlag GhcModeInteractive,
                        ghcOptOptimisation   = toFlag GhcNoOptimisation
                     }
        commonOpts  | withProfExe lbi = profOpts
                    | withDynExe  lbi = dynOpts
                    | otherwise       = staticOpts
        compileOpts | useDynToo = dynTooOpts
                    | otherwise = commonOpts
        withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi)
  
        -- For building exe's that use TH with -prof or -dynamic we actually have
        -- to build twice, once without -prof/-dynamic and then again with
        -- -prof/-dynamic. This is because the code that TH needs to run at
        -- compile time needs to be the vanilla ABI so it can be loaded up and run
        -- by the compiler.
        -- With dynamic-by-default GHC the TH object files loaded at compile-time
        -- need to be .dyn_o instead of .o.
        doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi
        -- Should we use -dynamic-too instead of compiling twice?
        useDynToo = dynamicTooSupported && isGhcjsDynamic
                    && doingTH && withStaticExe && null (ghcjsSharedOptions exeBi)
        compileTHOpts | isGhcjsDynamic = dynOpts
                      | otherwise      = staticOpts
        compileForTH
          | forRepl      = False
          | useDynToo    = False
          | isGhcjsDynamic = doingTH && (withProfExe lbi || withStaticExe)
          | otherwise      = doingTH && (withProfExe lbi || withDynExe lbi)
  
        linkOpts = commonOpts `mappend`
                   linkerOpts `mappend` mempty {
                        ghcOptLinkNoHsMain   = toFlag (not isHaskellMain)
                   }
  
    -- Build static/dynamic object files for TH, if needed.
    when compileForTH $
      runGhcjsProg compileTHOpts { ghcOptNoLink  = toFlag True
                                 , ghcOptNumJobs = numJobs }
  
    unless forRepl $
      runGhcjsProg compileOpts { ghcOptNoLink  = toFlag True
                               , ghcOptNumJobs = numJobs }
  
    -- build any C sources
    unless (null cSrcs || not nativeToo) $ do
     info verbosity "Building C Sources..."
     sequence_
       [ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi
                           clbi exeDir filename) `mappend` mempty {
                         ghcOptDynLinkMode   = toFlag (if withDynExe lbi
                                                         then GhcDynamicOnly
                                                         else GhcStaticOnly),
                         ghcOptProfilingMode = toFlag (withProfExe lbi)
                       }
                odir = fromFlag (ghcOptObjDir opts)
            createDirectoryIfMissingVerbose verbosity True odir
            runGhcjsProg opts
       | filename <- cSrcs ]
  
    -- TODO: problem here is we need the .c files built first, so we can load them
    -- with ghci, but .c files can depend on .h files generated by ghc by ffi
    -- exports.
    when forRepl $ runGhcjsProg replOpts
  
    -- link:
    unless forRepl $ do
      info verbosity "Linking..."
      runGhcjsProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> exeNameReal) }
  
  -- |Install for ghc, .hi, .a and, if --with-ghci given, .o
  installLib    :: Verbosity
                -> LocalBuildInfo
                -> FilePath  -- ^install location
                -> FilePath  -- ^install location for dynamic libraries
                -> FilePath  -- ^Build location
                -> PackageDescription
                -> Library
                -> ComponentLocalBuildInfo
                -> IO ()
  installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
    whenVanilla $ copyModuleFiles "js_hi"
    whenProf    $ copyModuleFiles "js_p_hi"
    whenShared  $ copyModuleFiles "js_dyn_hi"
  
    whenVanilla $ installOrdinary builtDir targetDir $ toJSLibName vanillaLibName
    whenProf    $ installOrdinary builtDir targetDir $ toJSLibName profileLibName
    whenShared  $ installShared   builtDir dynlibTargetDir $ toJSLibName sharedLibName
  
    when (ghcjsNativeToo $ compiler lbi) $ do
      -- copy .hi files over:
      whenVanilla $ copyModuleFiles "hi"
      whenProf    $ copyModuleFiles "p_hi"
      whenShared  $ copyModuleFiles "dyn_hi"
  
      -- copy the built library files over:
      whenVanilla $ installOrdinaryNative builtDir targetDir       vanillaLibName
      whenProf    $ installOrdinaryNative builtDir targetDir       profileLibName
      whenGHCi    $ installOrdinaryNative builtDir targetDir       ghciLibName
      whenShared  $ installSharedNative   builtDir dynlibTargetDir sharedLibName
  
    where
      install isShared isJS srcDir dstDir name = do
        let src = srcDir </> name
            dst = dstDir </> name
        createDirectoryIfMissingVerbose verbosity True dstDir
  
        if isShared
          then installExecutableFile verbosity src dst
          else installOrdinaryFile   verbosity src dst
  
        when (stripLibs lbi && not isJS) $
          Strip.stripLib verbosity
          (hostPlatform lbi) (withPrograms lbi) dst
  
      installOrdinary = install False True
      installShared   = install True  True
  
      installOrdinaryNative = install False False
      installSharedNative   = install True  False
  
      copyModuleFiles ext =
        findModuleFiles [builtDir] [ext] (allLibModules lib clbi)
        >>= installOrdinaryFiles verbosity targetDir
  
      compiler_id = compilerId (compiler lbi)
      uid = componentUnitId clbi
      vanillaLibName = mkLibName              uid
      profileLibName = mkProfLibName          uid
      ghciLibName    = Internal.mkGHCiLibName uid
      sharedLibName  = (mkSharedLibName compiler_id)  uid
  
      hasLib    = not $ null (allLibModules lib clbi)
                     && null (cSources (libBuildInfo lib))
      whenVanilla = when (hasLib && withVanillaLib lbi)
      whenProf    = when (hasLib && withProfLib    lbi)
      whenGHCi    = when (hasLib && withGHCiLib    lbi)
      whenShared  = when (hasLib && withSharedLib  lbi)
  
  installExe :: Verbosity
                -> LocalBuildInfo
                -> InstallDirs FilePath -- ^Where to copy the files to
                -> FilePath  -- ^Build location
                -> (FilePath, FilePath)  -- ^Executable (prefix,suffix)
                -> PackageDescription
                -> Executable
                -> IO ()
  installExe verbosity lbi installDirs buildPref
             (progprefix, progsuffix) _pkg exe = do
    let binDir = bindir installDirs
    createDirectoryIfMissingVerbose verbosity True binDir
    let exeName' = unUnqualComponentName $ exeName exe
        exeFileName = exeName'
        fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
        installBinary dest = do
          runDbProgram verbosity ghcjsProgram (withPrograms lbi) $
            [ "--install-executable"
            , buildPref </> exeName' </> exeFileName
            , "-o", dest
            ] ++
            case (stripExes lbi, lookupProgram stripProgram $ withPrograms lbi) of
             (True, Just strip) -> ["-strip-program", programPath strip]
             _                  -> []
    installBinary (binDir </> fixedExeBaseName)
  
  libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
             -> Library -> ComponentLocalBuildInfo -> IO String
  libAbiHash verbosity _pkg_descr lbi lib clbi = do
    let
        libBi       = libBuildInfo lib
        comp        = compiler lbi
        platform    = hostPlatform lbi
        vanillaArgs =
          (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
          `mappend` mempty {
            ghcOptMode         = toFlag GhcModeAbiHash,
            ghcOptInputModules = toNubListR $ PD.exposedModules lib
          }
        profArgs = adjustExts "js_p_hi" "js_p_o" vanillaArgs `mappend` mempty {
                       ghcOptProfilingMode = toFlag True,
                       ghcOptExtra         = toNubListR (ghcjsProfOptions libBi)
                   }
        ghcArgs = if withVanillaLib lbi then vanillaArgs
             else if withProfLib    lbi then profArgs
             else error "libAbiHash: Can't find an enabled library way"
    --
    (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi)
    hash <- getProgramInvocationOutput verbosity
            (ghcInvocation ghcjsProg comp platform ghcArgs)
    return (takeWhile (not . isSpace) hash)
  
  adjustExts :: String -> String -> GhcOptions -> GhcOptions
  adjustExts hiSuf objSuf opts =
    opts `mappend` mempty {
      ghcOptHiSuffix  = toFlag hiSuf,
      ghcOptObjSuffix = toFlag objSuf
    }
  
  registerPackage :: Verbosity
                  -> ProgramDb
                  -> PackageDBStack
                  -> InstalledPackageInfo
                  -> HcPkg.RegisterOptions
                  -> IO ()
  registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
      HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
                     installedPkgInfo registerOptions
  
  componentGhcOptions :: Verbosity -> LocalBuildInfo
                      -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
                      -> GhcOptions
  componentGhcOptions verbosity lbi bi clbi odir =
    let opts = Internal.componentGhcOptions verbosity implInfo lbi bi clbi odir
        comp = compiler lbi
        implInfo = getImplInfo comp
    in  opts { ghcOptExtra = ghcOptExtra opts `mappend` toNubListR
                               (hcOptions GHCJS bi)
             }
  
  ghcjsProfOptions :: BuildInfo -> [String]
  ghcjsProfOptions bi =
    hcProfOptions GHC bi `mappend` hcProfOptions GHCJS bi
  
  ghcjsSharedOptions :: BuildInfo -> [String]
  ghcjsSharedOptions bi =
    hcSharedOptions GHC bi `mappend` hcSharedOptions GHCJS bi
  
  isDynamic :: Compiler -> Bool
  isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
  
  supportsDynamicToo :: Compiler -> Bool
  supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
  
  findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version)
  findGhcjsGhcVersion verbosity pgm =
    findProgramVersion "--numeric-ghc-version" id verbosity pgm
  
  findGhcjsPkgGhcjsVersion :: Verbosity -> FilePath -> IO (Maybe Version)
  findGhcjsPkgGhcjsVersion verbosity pgm =
    findProgramVersion "--numeric-ghcjs-version" id verbosity pgm
  
  -- -----------------------------------------------------------------------------
  -- Registering
  
  hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
  hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram    = ghcjsPkgProg
                                     , HcPkg.noPkgDbStack    = False
                                     , HcPkg.noVerboseFlag   = False
                                     , HcPkg.flagPackageConf = False
                                     , HcPkg.supportsDirDbs  = True
                                     , HcPkg.requiresDirDbs  = ver >= v7_10
                                     , HcPkg.nativeMultiInstance  = ver >= v7_10
                                     , HcPkg.recacheMultiInstance = True
                                     , HcPkg.suppressFilesCheck   = True
                                     }
    where
      v7_10 = mkVersion [7,10]
      Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram progdb
      Just ver          = programVersion ghcjsPkgProg
  
  -- | Get the JavaScript file name and command and arguments to run a
  --   program compiled by GHCJS
  --   the exe should be the base program name without exe extension
  runCmd :: ProgramDb -> FilePath
              -> (FilePath, FilePath, [String])
  runCmd progdb exe =
    ( script
    , programPath ghcjsProg
    , programDefaultArgs ghcjsProg ++ programOverrideArgs ghcjsProg ++ ["--run"]
    )
    where
      script = exe <.> "jsexe" </> "all" <.> "js"
      Just ghcjsProg = lookupProgram ghcjsProgram progdb
  