-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.LHC
-- Copyright   :  Isaac Jones 2003-2007
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is a fairly large module. It contains most of the GHC-specific code for
-- configuring, building and installing packages. It also exports a function
-- for finding out what packages are already installed. Configuring involves
-- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
-- this version of ghc supports and returning a 'Compiler' value.
--
-- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
-- what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to take
-- into account. We have to build libs and programs, possibly for profiling and
-- shared libs. We have to support building libraries that will be usable by
-- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
-- using ghc. Linking, especially for @split-objs@ is remarkably complex,
-- partly because there tend to be 1,000's of @.o@ files and this can often be
-- more than we can pass to the @ld@ or @ar@ programs in one go.
--
-- Installing for libs and exes involves finding the right files and copying
-- them to the right places. One of the more tricky things about this module is
-- remembering the layout of files in the build directory (which is not
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.

{- Copyright (c) 2003-2005, Isaac Jones
All rights reserved.

Redistribution and use in source and binary forms, with or without
modiication, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

module Distribution.Simple.LHC (
        configure, getInstalledPackages,
        buildLib, buildExe,
        installLib, installExe,
        registerPackage,
        ghcOptions,
        ghcVerbosityOptions
 ) where

import Distribution.PackageDescription as PD
         ( PackageDescription(..), BuildInfo(..), Executable(..)
         , Library(..), libModules, hcOptions, usedExtensions, allExtensions )
import Distribution.InstalledPackageInfo
                                ( InstalledPackageInfo
                                , parseInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
                                ( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.ParseUtils  ( ParseResult(..) )
import Distribution.Simple.LocalBuildInfo
         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.InstallDirs
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
         ( PackageIdentifier, Package(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
         ( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
         , ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
         , rawSystemProgramStdout, rawSystemProgramStdoutConf
         , requireProgramVersion
         , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
         , arProgram, ranlibProgram, ldProgram
         , gccProgram, stripProgram
         , lhcProgram, lhcPkgProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Compiler
         ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
         , OptimisationLevel(..), PackageDB(..), PackageDBStack
         , Flag, languageToFlags, extensionsToFlags )
import Distribution.Version
         ( Version(..), orLaterVersion )
import Distribution.System
         ( OS(..), buildOS )
import Distribution.Verbosity
import Distribution.Text
         ( display, simpleParse )
import Language.Haskell.Extension
         ( Language(Haskell98), Extension(..), KnownExtension(..) )

import Control.Monad            ( unless, when )
import Data.List
import Data.Maybe               ( catMaybes )
import Data.Monoid              ( Monoid(..) )
import System.Directory         ( removeFile, renameFile,
                                  getDirectoryContents, doesFileExist,
                                  getTemporaryDirectory )
import System.FilePath          ( (</>), (<.>), takeExtension,
                                  takeDirectory, replaceExtension )
import System.IO (hClose, hPutStrLn)
import Distribution.Compat.Exception (catchExit, catchIO)

-- -----------------------------------------------------------------------------
-- Configuring

configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
          -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
configure verbosity hcPath hcPkgPath conf = do

  (lhcProg, lhcVersion, conf') <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram
      (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,7] [] :: [a][]))
      (userMaybeSpecifyPath ::
  String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "lhc" hcPath :: Maybe FilePathhcPath conf :: ProgramConfigurationconf)

  (lhcPkgProg, lhcPkgVersion, conf'') <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity lhcPkgProgram :: ProgramlhcPkgProgram
      (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [0,7] [] :: [a][]))
      (userMaybeSpecifyPath ::
  String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "lhc-pkg" hcPkgPath :: Maybe FilePathhcPkgPath conf' :: ProgramDbconf')

  when :: Monad m => Bool -> m () -> m ()when (lhcVersion :: VersionlhcVersion (/=) :: Eq a => a -> a -> Bool/= lhcPkgVersion :: VersionlhcPkgVersion) ($) :: (a -> b) -> a -> b$ die :: String -> IO adie ($) :: (a -> b) -> a -> b$
       "Version mismatch between lhc and lhc-pkg: "
    (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lhcVersion :: VersionlhcVersion (++) :: [a] -> [a] -> [a]++ " "
    (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath lhcPkgProg :: ConfiguredProgramlhcPkgProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lhcPkgVersion :: VersionlhcPkgVersion

  languages  <- getLanguages ::
  Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]getLanguages  verbosity :: Verbosityverbosity lhcProg :: ConfiguredProgramlhcProg
  extensions <- getExtensions ::
  Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]getExtensions verbosity :: Verbosityverbosity lhcProg :: ConfiguredProgramlhcProg

  let comp = Compiler {
        compilerId             = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId LHC :: CompilerFlavorLHC lhcVersion :: VersionlhcVersion,
        compilerLanguages      = languages :: [(Language, Flag)]languages,
        compilerExtensions     = extensions :: [(Extension, Flag)]extensions
      }
      conf''' = configureToolchain ::
  ConfiguredProgram -> ProgramConfiguration -> ProgramConfigurationconfigureToolchain lhcProg :: ConfiguredProgramlhcProg conf'' :: ProgramDbconf'' -- configure gcc and ld
  return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf''' :: ProgramConfigurationconf''')

-- | Adjust the way we find and configure gcc and ld
--
configureToolchain :: ConfiguredProgram -> ProgramConfiguration
                                        -> ProgramConfiguration
configureToolchain lhcProg =
    addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram gccProgram :: ProgramgccProgram {
      programFindLocation = findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)findProg gccProgram :: ProgramgccProgram (baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc.exe"),
      programPostConf     = configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureGcc
    }
  (.) :: (b -> c) -> (a -> b) -> a -> c. addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram ldProgram :: ProgramldProgram {
      programFindLocation = findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)findProg ldProgram :: ProgramldProgram (libDir :: FilePathlibDir (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe"),
      programPostConf     = configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd
    }
  where
    compilerDir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg)
    baseDir     = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir
    libDir      = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc-lib"
    includeDir  = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "include" (</>) :: FilePath -> FilePath -> FilePath</> "mingw"
    isWindows   = case buildOS :: OSbuildOS of Windows -> True :: BoolTrue; _ -> False :: BoolFalse

    -- on Windows finding and configuring ghc's gcc and ld is a bit special
    findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)
    findProg prog location | isWindows :: BoolisWindows = \verbosity -> do
        exists <- doesFileExist :: FilePath -> IO BooldoesFileExist location :: FilePathlocation
        if exists :: Boolexists then return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust location :: FilePathlocation)
                  else do warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ("Couldn't find " (++) :: [a] -> [a] -> [a]++ programName :: Program -> StringprogramName prog :: Programprog (++) :: [a] -> [a] -> [a]++ " where I expected it. Trying the search path.")
                          programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog verbosity :: Verbosityverbosity
      | otherwise :: Boolotherwise = programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog

    configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
    configureGcc
      | isWindows :: BoolisWindows = \_ gccProg -> case programLocation :: ConfiguredProgram -> ProgramLocationprogramLocation gccProg :: ConfiguredProgramgccProg of
          -- if it's found on system then it means we're using the result
          -- of programFindLocation above rather than a user-supplied path
          -- that means we should add this extra flag to tell ghc's gcc
          -- where it lives and thus where gcc can find its various files:
          FoundOnSystem {} -> return :: Monad m => forall a. a -> m areturn ["-B" (++) :: [a] -> [a] -> [a]++ libDir :: FilePathlibDir, "-I" (++) :: [a] -> [a] -> [a]++ includeDir :: FilePathincludeDir]
          UserSpecified {} -> return :: Monad m => forall a. a -> m areturn [] :: [a][]
      | otherwise :: Boolotherwise = \_ _   -> return :: Monad m => forall a. a -> m areturn [] :: [a][]

    -- we need to find out if ld supports the -x flag
    configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
    configureLd verbosity ldProg = do
      tempDir <- getTemporaryDirectory :: IO FilePathgetTemporaryDirectory
      ldx <- withTempFile ::
  FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".c" ($) :: (a -> b) -> a -> b$ \testcfile testchnd ->
             withTempFile ::
  FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".o" ($) :: (a -> b) -> a -> b$ \testofile testohnd -> do
               hPutStrLn :: Handle -> String -> IO ()hPutStrLn testchnd :: Handletestchnd "int foo() {}"
               hClose :: Handle -> IO ()hClose testchnd :: Handletestchnd; hClose :: Handle -> IO ()hClose testohnd :: Handletestohnd
               rawSystemProgram ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity lhcProg :: ConfiguredProgramlhcProg ["-c", testcfile :: FilePathtestcfile,
                                                   "-o", testofile :: FilePathtestofile]
               withTempFile ::
  FilePath -> String -> (FilePath -> Handle -> IO a) -> IO awithTempFile tempDir :: FilePathtempDir ".o" ($) :: (a -> b) -> a -> b$ \testofile' testohnd' ->
                 do
                   hClose :: Handle -> IO ()hClose testohnd' :: Handletestohnd'
                   _ <- rawSystemProgramStdout ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringrawSystemProgramStdout verbosity :: Verbosityverbosity ldProg :: ConfiguredProgramldProg
                     ["-x", "-r", testofile :: FilePathtestofile, "-o", testofile' :: FilePathtestofile']
                   return :: Monad m => forall a. a -> m areturn True :: BoolTrue
                 catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO`   (\_ -> return :: Monad m => forall a. a -> m areturn False :: BoolFalse)
                 catchExit :: IO a -> (ExitCode -> IO a) -> IO a`catchExit` (\_ -> return :: Monad m => forall a. a -> m areturn False :: BoolFalse)
      if ldx :: Boolldx
        then return :: Monad m => forall a. a -> m areturn ["-x"]
        else return :: Monad m => forall a. a -> m areturn [] :: [a][]

getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
getLanguages _ _ = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98, "")]
--FIXME: does lhc support -XHaskell98 flag? from what version?

getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity lhcProg = do
    exts <- rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO StringrawSystemStdout verbosity :: Verbosityverbosity (programPath :: ConfiguredProgram -> FilePathprogramPath lhcProg :: ConfiguredProgramlhcProg)
              ["--supported-languages"]
    -- GHC has the annoying habit of inverting some of the extensions
    -- so we have to try parsing ("No" ++ ghcExtensionName) first
    let readExtension str = do
          ext <- simpleParse :: Text a => String -> Maybe asimpleParse ("No" (++) :: [a] -> [a] -> [a]++ str :: [Char]str)
          case ext :: Extensionext of
            UnknownExtension _ -> simpleParse :: Text a => String -> Maybe asimpleParse str :: [Char]str
            _                  -> return :: Monad m => forall a. a -> m areturn ext :: Extensionext
    return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ [ (ext :: Extensionext, "-X" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ext :: Extensionext)
             | Just ext <- map :: (a -> b) -> [a] -> [b]map readExtension :: [Char] -> Maybe ExtensionreadExtension (lines :: String -> [String]lines exts :: Stringexts) ]

getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
                     -> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
  checkPackageDbStack :: PackageDBStack -> IO ()checkPackageDbStack packagedbs :: PackageDBStackpackagedbs
  pkgss <- getInstalledPackages' ::
  Verbosity
  -> [PackageDB]
  -> ProgramConfiguration
  -> IO [(PackageDB, [InstalledPackageInfo])]getInstalledPackages' verbosity :: Verbosityverbosity packagedbs :: PackageDBStackpackagedbs conf :: ProgramConfigurationconf
  let indexes = [ fromList :: [InstalledPackageInfo] -> PackageIndexPackageIndex.fromList (map :: (a -> b) -> [a] -> [b]map (substTopDir ::
  FilePath -> InstalledPackageInfo -> InstalledPackageInfosubstTopDir topDir :: FilePathtopDir) pkgs :: [InstalledPackageInfo]pkgs)
                | (_, pkgs) <- pkgss :: [(PackageDB, [InstalledPackageInfo])]pkgss ]
  return :: Monad m => forall a. a -> m areturn ($!) :: (a -> b) -> a -> b$! (mconcat :: Monoid a => [a] -> amconcat indexes :: [PackageIndex]indexes)

  where
    -- 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
    Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram lhcProgram :: ProgramlhcProgram conf :: ProgramConfigurationconf
    compilerDir  = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
    topDir       = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir

checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
  | GlobalPackageDB :: PackageDBGlobalPackageDB notElem :: Eq a => a -> [a] -> Bool`notElem` rest :: [PackageDB]rest = return :: Monad m => forall a. a -> m areturn ()
checkPackageDbStack _ =
  die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "GHC.getInstalledPackages: the global package db must be "
     (++) :: [a] -> [a] -> [a]++ "specified first and cannot be specified multiple times"

-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
                     -> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
  =
  sequence :: Monad m => [m a] -> m [a]sequence
    [ do str <- rawSystemProgramStdoutConf ::
  Verbosity
  -> Program
  -> ProgramConfiguration
  -> [ProgArg]
  -> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity lhcPkgProgram :: ProgramlhcPkgProgram conf :: ProgramConfigurationconf
                  ["dump", packageDbGhcPkgFlag :: PackageDB -> [Char]packageDbGhcPkgFlag packagedb :: PackageDBpackagedb]
           catchExit :: IO a -> (ExitCode -> IO a) -> IO a`catchExit` \_ -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "ghc-pkg dump failed"
         case parsePackages :: String -> Either [InstalledPackageInfo] [PError]parsePackages str :: [Char]str of
           Left ok -> return :: Monad m => forall a. a -> m areturn (packagedb :: PackageDBpackagedb, ok :: [InstalledPackageInfo]ok)
           _       -> die :: String -> IO adie "failed to parse output of 'ghc-pkg dump'"
    | packagedb <- packagedbs :: PackageDBStackpackagedbs ]

  where
    parsePackages str =
      let parsed = map :: (a -> b) -> [a] -> [b]map parseInstalledPackageInfo ::
  String -> ParseResult InstalledPackageInfoparseInstalledPackageInfo (splitPkgs :: String -> [String]splitPkgs str :: [Char]str)
       in case [ msg :: PErrormsg | ParseFailed msg <- parsed :: [ParseResult InstalledPackageInfo]parsed ] of
            []   -> Left :: a -> Either a bLeft [ pkg :: InstalledPackageInfopkg | ParseOk _ pkg <- parsed :: [ParseResult InstalledPackageInfo]parsed ]
            msgs -> Right :: b -> Either a bRight msgs :: [PError]msgs

    splitPkgs :: String -> [String]
    splitPkgs = map :: (a -> b) -> [a] -> [b]map unlines :: [String] -> Stringunlines (.) :: (b -> c) -> (a -> b) -> a -> c. splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith ("---" (==) :: Eq a => a -> a -> Bool==) (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
      where
        splitWith :: (a -> Bool) -> [a] -> [[a]]
        splitWith p xs = ys :: [a]ys (:) :: a -> [a] -> [a]: case zs :: [a]zs of
                           []   -> [] :: [a][]
                           _:ws -> splitWith :: (a -> Bool) -> [a] -> [[a]]splitWith p :: a -> Boolp ws :: [a]ws
          where (ys,zs) = break :: (a -> Bool) -> [a] -> ([a], [a])break p :: a -> Boolp xs :: [a]xs

    packageDbGhcPkgFlag GlobalPackageDB          = "--global"
    packageDbGhcPkgFlag UserPackageDB            = "--user"
    packageDbGhcPkgFlag (SpecificPackageDB path) = "--package-conf=" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath


substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
 = ipo :: InstalledPackageInfoipo {
       InstalledPackageInfo.importDirs
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (importDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.importDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.libraryDirs
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (libraryDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.libraryDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.includeDirs
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.frameworkDirs
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.frameworkDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.haddockInterfaces
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockInterfaces ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.haddockHTMLs
           = map :: (a -> b) -> [a] -> [b]map f :: [Char] -> [Char]f (haddockHTMLs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockHTMLs ipo :: InstalledPackageInfoipo)
   }
    where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir :: FilePathtopDir (++) :: [a] -> [a] -> [a]++ rest :: [PackageDB]rest
          f x = x :: [Char]x

-- -----------------------------------------------------------------------------
-- Building

-- | Build a library with LHC.
--
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
  let pref = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi
      pkgid = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr
      runGhcProg = rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
      ifVanillaLib forceVanilla = when :: Monad m => Bool -> m () -> m ()when (forceVanilla :: BoolforceVanilla (||) :: Bool -> Bool -> Bool|| withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)
      ifProfLib = when :: Monad m => Bool -> m () -> m ()when (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
      ifSharedLib = when :: Monad m => Bool -> m () -> m ()when (withSharedLib :: LocalBuildInfo -> BoolwithSharedLib lbi :: LocalBuildInfolbi)
      ifGHCiLib = when :: Monad m => Bool -> m () -> m ()when (withGHCiLib :: LocalBuildInfo -> BoolwithGHCiLib lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)

  libBi <- hackThreadedFlag ::
  Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
             (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi) (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib)

  let libTargetDir = pref :: FilePathpref
      forceVanillaLib = EnableExtension :: KnownExtension -> ExtensionEnableExtension TemplateHaskell :: KnownExtensionTemplateHaskell elem :: Eq a => a -> [a] -> Bool`elem` allExtensions :: BuildInfo -> [Extension]allExtensions libBi :: BuildInfolibBi
      -- TH always needs vanilla libs, even when building for profiling

  createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue libTargetDir :: FilePathlibTargetDir
  -- TODO: do we need to put hs-boot files into place for mutually recurive modules?
  let ghcArgs =
             ["-package-name", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid ]
          (++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> Verbosity
  -> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi libTargetDir :: FilePathlibTargetDir verbosity :: Verbosityverbosity
          (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
      lhcWrap x = ["--build-library", "--ghc-opts=" (++) :: [a] -> [a] -> [a]++ unwords :: [String] -> Stringunwords x :: [Char]x]
      ghcArgsProf = ghcArgs :: [[Char]]ghcArgs
          (++) :: [a] -> [a] -> [a]++ ["-prof",
              "-hisuf", "p_hi",
              "-osuf", "p_o"
             ]
          (++) :: [a] -> [a] -> [a]++ ghcProfOptions :: BuildInfo -> [String]ghcProfOptions libBi :: BuildInfolibBi
      ghcArgsShared = ghcArgs :: [[Char]]ghcArgs
          (++) :: [a] -> [a] -> [a]++ ["-dynamic",
              "-hisuf", "dyn_hi",
              "-osuf", "dyn_o", "-fPIC"
             ]
          (++) :: [a] -> [a] -> [a]++ ghcSharedOptions :: BuildInfo -> [String]ghcSharedOptions libBi :: BuildInfolibBi
  unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)) ($) :: (a -> b) -> a -> b$
    do ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib forceVanillaLib :: BoolforceVanillaLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap ghcArgs :: [[Char]]ghcArgs)
       ifProfLib :: IO () -> IO ()ifProfLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap ghcArgsProf :: [[Char]]ghcArgsProf)
       ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap ghcArgsShared :: [[Char]]ghcArgsShared)

  -- build any C sources
  unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)) ($) :: (a -> b) -> a -> b$ do
     info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Building C Sources..."
     sequence_ :: Monad m => [m a] -> m ()sequence_ [do let (odir,args) = constructCcCmdLine ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> FilePath
  -> Verbosity
  -> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi pref :: FilePathpref
                                                        filename :: FilePathfilename verbosity :: Verbosityverbosity
                   createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
                   runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [ProgArg]args
                   ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg (args :: [ProgArg]args (++) :: [a] -> [a] -> [a]++ ["-fPIC", "-osuf dyn_o"]))
               | filename <- cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi]

  -- link:
  info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Linking..."
  let cObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` objExtension :: StringobjExtension) (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)
      cSharedObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` ("dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension)) (cSources :: BuildInfo -> [FilePath]cSources libBi :: BuildInfolibBi)
      vanillaLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkLibName :: PackageIdentifier -> StringmkLibName pkgid :: PackageIdentifierpkgid
      profileLibFilePath = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkProfLibName :: PackageIdentifier -> StringmkProfLibName pkgid :: PackageIdentifierpkgid
      sharedLibFilePath  = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid
                                              (compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))
      ghciLibFilePath    = libTargetDir :: FilePathlibTargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkGHCiLibName :: PackageIdentifier -> StringmkGHCiLibName pkgid :: PackageIdentifierpkgid

  stubObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
    [ findFileWithExtension ::
  [String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension [objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
        (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
    | x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
  stubProfObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
    [ findFileWithExtension ::
  [String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["p_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
        (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
    | x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
  stubSharedObjs <- fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ sequence :: Monad m => [m a] -> m [a]sequence
    [ findFileWithExtension ::
  [String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension] [libTargetDir :: FilePathlibTargetDir]
        (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++"_stub")
    | x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]

  hObjs     <- getHaskellObjects ::
  Library
  -> LocalBuildInfo
  -> FilePath
  -> String
  -> Bool
  -> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
                    pref :: FilePathpref objExtension :: StringobjExtension True :: BoolTrue
  hProfObjs <-
    if (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
            then getHaskellObjects ::
  Library
  -> LocalBuildInfo
  -> FilePath
  -> String
  -> Bool
  -> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
                    pref :: FilePathpref ("p_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension) True :: BoolTrue
            else return :: Monad m => forall a. a -> m areturn [] :: [a][]
  hSharedObjs <-
    if (withSharedLib :: LocalBuildInfo -> BoolwithSharedLib lbi :: LocalBuildInfolbi)
            then getHaskellObjects ::
  Library
  -> LocalBuildInfo
  -> FilePath
  -> String
  -> Bool
  -> IO [FilePath]getHaskellObjects lib :: Librarylib lbi :: LocalBuildInfolbi
                    pref :: FilePathpref ("dyn_" (++) :: [a] -> [a] -> [a]++ objExtension :: StringobjExtension) False :: BoolFalse
            else return :: Monad m => forall a. a -> m areturn [] :: [a][]

  unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull hObjs :: [FilePath]hObjs (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull cObjs :: [FilePath]cObjs (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull stubObjs :: [FilePath]stubObjs) ($) :: (a -> b) -> a -> b$ do
    -- first remove library files if they exists
    sequence_ :: Monad m => [m a] -> m ()sequence_
      [ removeFile :: FilePath -> IO ()removeFile libFilePath :: FilePathlibFilePath catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` \_ -> return :: Monad m => forall a. a -> m areturn ()
      | libFilePath <- [vanillaLibFilePath :: FilePathvanillaLibFilePath, profileLibFilePath :: FilePathprofileLibFilePath
                       ,sharedLibFilePath :: FilePathsharedLibFilePath,  ghciLibFilePath :: FilePathghciLibFilePath] ]

    let arVerbosity | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = "v"
                    | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal = ""
                    | otherwise :: Boolotherwise = "c"
        arArgs = ["q"(++) :: [a] -> [a] -> [a]++ arVerbosity :: [Char]arVerbosity]
            (++) :: [a] -> [a] -> [a]++ [vanillaLibFilePath :: FilePathvanillaLibFilePath]
        arObjArgs =
               hObjs :: [FilePath]hObjs
            (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
            (++) :: [a] -> [a] -> [a]++ stubObjs :: [FilePath]stubObjs
        arProfArgs = ["q"(++) :: [a] -> [a] -> [a]++ arVerbosity :: [Char]arVerbosity]
            (++) :: [a] -> [a] -> [a]++ [profileLibFilePath :: FilePathprofileLibFilePath]
        arProfObjArgs =
               hProfObjs :: [FilePath]hProfObjs
            (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
            (++) :: [a] -> [a] -> [a]++ stubProfObjs :: [FilePath]stubProfObjs
        ldArgs = ["-r"]
            (++) :: [a] -> [a] -> [a]++ ["-o", ghciLibFilePath :: FilePathghciLibFilePath (<.>) :: FilePath -> String -> FilePath<.> "tmp"]
        ldObjArgs =
               hObjs :: [FilePath]hObjs
            (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cObjs :: [FilePath]cObjs
            (++) :: [a] -> [a] -> [a]++ stubObjs :: [FilePath]stubObjs
        ghcSharedObjArgs =
               hSharedObjs :: [FilePath]hSharedObjs
            (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</>) cSharedObjs :: [FilePath]cSharedObjs
            (++) :: [a] -> [a] -> [a]++ stubSharedObjs :: [FilePath]stubSharedObjs
        -- 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 =
            [ "-no-auto-link-packages",
              "-shared",
              "-dynamic",
              "-o", sharedLibFilePath :: FilePathsharedLibFilePath ]
            (++) :: [a] -> [a] -> [a]++ ghcSharedObjArgs :: [FilePath]ghcSharedObjArgs
            (++) :: [a] -> [a] -> [a]++ ["-package-name", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid ]
            (++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
  LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
            (++) :: [a] -> [a] -> [a]++ ["-l"(++) :: [a] -> [a] -> [a]++extraLib :: StringextraLib | extraLib <- extraLibs :: BuildInfo -> [String]extraLibs libBi :: BuildInfolibBi]
            (++) :: [a] -> [a] -> [a]++ ["-L"(++) :: [a] -> [a] -> [a]++extraLibDir :: StringextraLibDir | extraLibDir <- extraLibDirs :: BuildInfo -> [String]extraLibDirs libBi :: BuildInfolibBi]

        runLd ldLibName args = do
          exists <- doesFileExist :: FilePath -> IO BooldoesFileExist ldLibName :: FilePathldLibName
            -- This method is called iteratively by xargs. The
            -- output goes to <ldLibName>.tmp, and any existing file
            -- named <ldLibName> is included when linking. The
            -- output is renamed to <libName>.
          rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity ldProgram :: ProgramldProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
            (args :: [ProgArg]args (++) :: [a] -> [a] -> [a]++ if exists :: Boolexists then [ldLibName :: FilePathldLibName] else [] :: [a][])
          renameFile :: FilePath -> FilePath -> IO ()renameFile (ldLibName :: FilePathldLibName (<.>) :: FilePath -> String -> FilePath<.> "tmp") ldLibName :: FilePathldLibName

        runAr = rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)

         --TODO: discover this at configure time or runtime on unix
         -- The value is 32k on Windows and posix specifies a minimum of 4k
         -- but all sensible unixes use more than 4k.
         -- we could use getSysVar ArgumentLimit but that's in the unix lib
        maxCommandLineSize = 30 (*) :: Num a => a -> a -> a* 1024

    ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib False :: BoolFalse ($) :: (a -> b) -> a -> b$ xargs ::
  Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
      runAr :: [ProgArg] -> IO ()runAr arArgs :: [[Char]]arArgs arObjArgs :: [FilePath]arObjArgs

    ifProfLib :: IO () -> IO ()ifProfLib ($) :: (a -> b) -> a -> b$ xargs ::
  Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
      runAr :: [ProgArg] -> IO ()runAr arProfArgs :: [[Char]]arProfArgs arProfObjArgs :: [FilePath]arProfObjArgs

    ifGHCiLib :: IO () -> IO ()ifGHCiLib ($) :: (a -> b) -> a -> b$ xargs ::
  Int -> ([String] -> IO ()) -> [String] -> [String] -> IO ()xargs maxCommandLineSize :: IntmaxCommandLineSize
      (runLd :: FilePath -> [ProgArg] -> IO ()runLd ghciLibFilePath :: FilePathghciLibFilePath) ldArgs :: [[Char]]ldArgs ldObjArgs :: [FilePath]ldObjArgs

    ifSharedLib :: IO () -> IO ()ifSharedLib ($) :: (a -> b) -> a -> b$ runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcSharedLinkArgs :: [[Char]]ghcSharedLinkArgs


-- | Build an executable with LHC.
--
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity _pkg_descr lbi
  exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
  let pref = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi
      runGhcProg = rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)

  exeBi <- hackThreadedFlag ::
  Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
             (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi) (buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe)

  -- exeNameReal, the name that GHC really uses (with .exe on Windows)
  let exeNameReal = exeName' :: StringexeName' (<.>) :: FilePath -> String -> FilePath<.>
                    (if null :: [a] -> Boolnull ($) :: (a -> b) -> a -> b$ takeExtension :: FilePath -> StringtakeExtension exeName' :: StringexeName' then exeExtension :: StringexeExtension else "")

  let targetDir = pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> exeName' :: StringexeName'
  let exeDir    = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> (exeName' :: StringexeName' (++) :: [a] -> [a] -> [a]++ "-tmp")
  createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue targetDir :: FilePathtargetDir
  createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue exeDir :: FilePathexeDir
  -- TODO: do we need to put hs-boot files into place for mutually recursive modules?
  -- FIX: what about exeName.hi-boot?

  -- build executables
  unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi)) ($) :: (a -> b) -> a -> b$ do
   info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Building C Sources."
   sequence_ :: Monad m => [m a] -> m ()sequence_ [do let (odir,args) = constructCcCmdLine ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> FilePath
  -> Verbosity
  -> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi
                                          exeDir :: FilePathexeDir filename :: FilePathfilename verbosity :: Verbosityverbosity
                 createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
                 runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [ProgArg]args
             | filename <- cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi]

  srcMainFile <- findFile :: [FilePath] -> FilePath -> IO FilePathfindFile (exeDir :: FilePathexeDir (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs exeBi :: BuildInfoexeBi) modPath :: FilePathmodPath

  let cObjs = map :: (a -> b) -> [a] -> [b]map (replaceExtension :: FilePath -> String -> FilePath`replaceExtension` objExtension :: StringobjExtension) (cSources :: BuildInfo -> [FilePath]cSources exeBi :: BuildInfoexeBi)
  let lhcWrap x = ("--ghc-opts\""(:) :: a -> [a] -> [a]:x :: [Char]x) (++) :: [a] -> [a] -> [a]++ ["\""]
  let binArgs linkExe profExe =
             (if linkExe :: BoollinkExe
                 then ["-o", targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> exeNameReal :: FilePathexeNameReal]
                 else ["-c"])
          (++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> Verbosity
  -> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi exeDir :: FilePathexeDir verbosity :: Verbosityverbosity
          (++) :: [a] -> [a] -> [a]++ [exeDir :: FilePathexeDir (</>) :: FilePath -> FilePath -> FilePath</> x :: [Char]x | x <- cObjs :: [FilePath]cObjs]
          (++) :: [a] -> [a] -> [a]++ [srcMainFile :: FilePathsrcMainFile]
          (++) :: [a] -> [a] -> [a]++ ["-optl" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- ldOptions :: BuildInfo -> [String]PD.ldOptions exeBi :: BuildInfoexeBi]
          (++) :: [a] -> [a] -> [a]++ ["-l"(++) :: [a] -> [a] -> [a]++lib :: Librarylib | lib <- extraLibs :: BuildInfo -> [String]extraLibs exeBi :: BuildInfoexeBi]
          (++) :: [a] -> [a] -> [a]++ ["-L"(++) :: [a] -> [a] -> [a]++libDir :: FilePathlibDir | libDir <- extraLibDirs :: BuildInfo -> [String]extraLibDirs exeBi :: BuildInfoexeBi]
          (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [["-framework", f :: [Char] -> [Char]f] | f <- frameworks :: BuildInfo -> [String]PD.frameworks exeBi :: BuildInfoexeBi]
          (++) :: [a] -> [a] -> [a]++ if profExe :: BoolprofExe
                then ["-prof",
                      "-hisuf", "p_hi",
                      "-osuf", "p_o"
                     ] (++) :: [a] -> [a] -> [a]++ ghcProfOptions :: BuildInfo -> [String]ghcProfOptions exeBi :: BuildInfoexeBi
                else [] :: [a][]

  -- For building exe's for profiling that use TH we actually
  -- have to build twice, once without profiling and the again
  -- with profiling. 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.
  when :: Monad m => Bool -> m () -> m ()when (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& EnableExtension :: KnownExtension -> ExtensionEnableExtension TemplateHaskell :: KnownExtensionTemplateHaskell elem :: Eq a => a -> [a] -> Bool`elem` allExtensions :: BuildInfo -> [Extension]allExtensions exeBi :: BuildInfoexeBi)
     (runGhcProg :: [ProgArg] -> IO ()runGhcProg ($) :: (a -> b) -> a -> b$ lhcWrap :: [String] -> [[Char]]lhcWrap (binArgs :: Bool -> Bool -> [[Char]]binArgs False :: BoolFalse False :: BoolFalse))

  runGhcProg :: [ProgArg] -> IO ()runGhcProg (binArgs :: Bool -> Bool -> [[Char]]binArgs True :: BoolTrue (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi))

-- | Filter the "-threaded" flag when profiling as it does not
--   work with ghc-6.8 and older.
hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
hackThreadedFlag verbosity comp prof bi
  | not :: Bool -> Boolnot mustFilterThreaded :: BoolmustFilterThreaded = return :: Monad m => forall a. a -> m areturn bi :: BuildInfobi
  | otherwise :: Boolotherwise              = do
    warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "The ghc flag '-threaded' is not compatible with "
                  (++) :: [a] -> [a] -> [a]++ "profiling in ghc-6.8 and older. It will be disabled."
    return :: Monad m => forall a. a -> m areturn bi :: BuildInfobi { options = filterHcOptions ::
  (a -> Bool) -> [(CompilerFlavor, [a])] -> [(CompilerFlavor, [a])]filterHcOptions ((/=) :: Eq a => a -> a -> Bool/= "-threaded") (options :: BuildInfo -> [(CompilerFlavor, [String])]options bi :: BuildInfobi) }
  where
    mustFilterThreaded = prof :: Boolprof (&&) :: Bool -> Bool -> Bool&& compilerVersion :: Compiler -> VersioncompilerVersion comp :: Compilercomp (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6, 10] [] :: [a][]
                      (&&) :: Bool -> Bool -> Bool&& "-threaded" elem :: Eq a => a -> [a] -> Bool`elem` hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions GHC :: CompilerFlavorGHC bi :: BuildInfobi
    filterHcOptions p hcoptss =
      [ (hc :: CompilerFlavorhc, if hc :: CompilerFlavorhc (==) :: Eq a => a -> a -> Bool== GHC :: CompilerFlavorGHC then filter :: (a -> Bool) -> [a] -> [a]filter p :: a -> Boolp opts :: [a]opts else opts :: [a]opts)
      | (hc, opts) <- hcoptss :: [(CompilerFlavor, [a])]hcoptss ]

-- when using -split-objs, we need to search for object files in the
-- Module_split directory for each module.
getHaskellObjects :: Library -> LocalBuildInfo
                  -> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
  | splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi (&&) :: Bool -> Bool -> Bool&& allow_split_objs :: Boolallow_split_objs = do
        let dirs = [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++ "_split")
                   | x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]
        objss <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM getDirectoryContents :: FilePath -> IO [FilePath]getDirectoryContents dirs :: [FilePath]dirs
        let objs = [ dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> obj :: FilePathobj
                   | (objs',dir) <- zip :: [a] -> [b] -> [(a, b)]zip objss :: [[FilePath]]objss dirs :: [FilePath]dirs, obj <- objs' :: [FilePath]objs',
                     let obj_ext = takeExtension :: FilePath -> StringtakeExtension obj :: FilePathobj,
                     '.'(:) :: a -> [a] -> [a]:wanted_obj_ext :: Stringwanted_obj_ext (==) :: Eq a => a -> a -> Bool== obj_ext :: Stringobj_ext ]
        return :: Monad m => forall a. a -> m areturn objs :: [FilePath]objs
  | otherwise :: Boolotherwise  =
        return :: Monad m => forall a. a -> m areturn [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (<.>) :: FilePath -> String -> FilePath<.> wanted_obj_ext :: Stringwanted_obj_ext
               | x <- libModules :: Library -> [ModuleName]libModules lib :: Librarylib ]


constructGHCCmdLine
        :: LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> Verbosity
        -> [String]
constructGHCCmdLine lbi bi clbi odir verbosity =
        ["--make"]
     (++) :: [a] -> [a] -> [a]++ ghcVerbosityOptions :: Verbosity -> [String]ghcVerbosityOptions verbosity :: Verbosityverbosity
        -- Unsupported extensions have already been checked by configure
     (++) :: [a] -> [a] -> [a]++ ghcOptions ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> [String]ghcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi odir :: FilePathodir

ghcVerbosityOptions :: Verbosity -> [String]
ghcVerbosityOptions verbosity
     | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = ["-v"]
     | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal    = [] :: [a][]
     | otherwise :: Boolotherwise              = ["-w", "-v0"]

ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
           -> FilePath -> [String]
ghcOptions lbi bi clbi odir
     =  ["-hide-all-packages"]
     (++) :: [a] -> [a] -> [a]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
     (++) :: [a] -> [a] -> [a]++ (if splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi then ["-split-objs"] else [] :: [a][])
     (++) :: [a] -> [a] -> [a]++ ["-i"]
     (++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ odir :: FilePathodir]
     (++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ l :: FilePathl | l <- nub :: Eq a => [a] -> [a]nub (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)]
     (++) :: [a] -> [a] -> [a]++ ["-i" (++) :: [a] -> [a] -> [a]++ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
     (++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi]
     (++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ odir :: FilePathodir]
     (++) :: [a] -> [a] -> [a]++ ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi]
     (++) :: [a] -> [a] -> [a]++ ["-optP" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- cppOptions :: BuildInfo -> [String]cppOptions bi :: BuildInfobi]
     (++) :: [a] -> [a] -> [a]++ [ "-optP-include", "-optP"(++) :: [a] -> [a] -> [a]++ (autogenModulesDir :: LocalBuildInfo -> StringautogenModulesDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> cppHeaderName :: StringcppHeaderName) ]
     (++) :: [a] -> [a] -> [a]++ [ "-#include \"" (++) :: [a] -> [a] -> [a]++ inc :: FilePathinc (++) :: [a] -> [a] -> [a]++ "\"" | inc <- includes :: BuildInfo -> [FilePath]PD.includes bi :: BuildInfobi ]
     (++) :: [a] -> [a] -> [a]++ [ "-odir",  odir :: FilePathodir, "-hidir", odir :: FilePathodir ]
     (++) :: [a] -> [a] -> [a]++ (if compilerVersion :: Compiler -> VersioncompilerVersion c :: Compilerc (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,8] [] :: [a][]
           then ["-stubdir", odir :: FilePathodir] else [] :: [a][])
     (++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
  LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
     (++) :: [a] -> [a] -> [a]++ (case withOptimization :: LocalBuildInfo -> OptimisationLevelwithOptimization lbi :: LocalBuildInfolbi of
           NoOptimisation      -> [] :: [a][]
           NormalOptimisation  -> ["-O"]
           MaximumOptimisation -> ["-O2"])
     (++) :: [a] -> [a] -> [a]++ hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions GHC :: CompilerFlavorGHC bi :: BuildInfobi
     (++) :: [a] -> [a] -> [a]++ languageToFlags :: Compiler -> Maybe Language -> [Flag]languageToFlags c :: Compilerc (defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage bi :: BuildInfobi)
     (++) :: [a] -> [a] -> [a]++ extensionsToFlags :: Compiler -> [Extension] -> [Flag]extensionsToFlags c :: Compilerc (usedExtensions :: BuildInfo -> [Extension]usedExtensions bi :: BuildInfobi)
    where c = compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi

ghcPackageFlags :: LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
ghcPackageFlags lbi clbi
  | ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][]
              = concat :: [[a]] -> [a]concat [ ["-package-id", display :: Text a => a -> Stringdisplay ipkgid :: InstalledPackageIdipkgid]
                       | (ipkgid, _) <- componentPackageDeps ::
  ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]

  | otherwise :: Boolotherwise = concat :: [[a]] -> [a]concat [ ["-package", display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid]
                       | (_, pkgid)  <- componentPackageDeps ::
  ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
    where
      ghcVer = compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi)

ghcPackageDbOptions :: PackageDBStack -> [String]
ghcPackageDbOptions dbstack = case dbstack :: PackageDBStackdbstack of
  (GlobalPackageDB:UserPackageDB:dbs) -> concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: PackageDB -> [[Char]]specific dbs :: [PackageDB]dbs
  (GlobalPackageDB:dbs)               -> "-no-user-package-conf"
                                       (:) :: a -> [a] -> [a]: concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: PackageDB -> [[Char]]specific dbs :: [PackageDB]dbs
  _                                   -> ierror :: tierror
 where
    specific (SpecificPackageDB db) = [ "-package-conf", db :: FilePathdb ]
    specific _ = ierror :: tierror
    ierror     = error :: [Char] -> aerror ("internal error: unexpected package db stack: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow dbstack :: PackageDBStackdbstack)

constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
                   -> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity
  =  let odir | compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,4,1] [] :: [a][]  = pref :: FilePathpref
              | otherwise :: Boolotherwise = pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> takeDirectory :: FilePath -> FilePathtakeDirectory filename :: FilePathfilename
                        -- ghc 6.4.1 fixed a bug in -odir handling
                        -- for C compilations.
     in
        (odir :: FilePathodir,
         ghcCcOptions ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> [String]ghcCcOptions lbi :: LocalBuildInfolbi bi :: BuildInfobi clbi :: ComponentLocalBuildInfoclbi odir :: FilePathodir
         (++) :: [a] -> [a] -> [a]++ (if verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening then ["-v"] else [] :: [a][])
         (++) :: [a] -> [a] -> [a]++ ["-c",filename :: FilePathfilename])


ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
             -> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
     =  ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- includeDirs :: BuildInfo -> [FilePath]PD.includeDirs bi :: BuildInfobi]
     (++) :: [a] -> [a] -> [a]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
     (++) :: [a] -> [a] -> [a]++ ghcPackageFlags ::
  LocalBuildInfo -> ComponentLocalBuildInfo -> [String]ghcPackageFlags lbi :: LocalBuildInfolbi clbi :: ComponentLocalBuildInfoclbi
     (++) :: [a] -> [a] -> [a]++ ["-optc" (++) :: [a] -> [a] -> [a]++ opt :: Stringopt | opt <- ccOptions :: BuildInfo -> [String]PD.ccOptions bi :: BuildInfobi]
     (++) :: [a] -> [a] -> [a]++ (case withOptimization :: LocalBuildInfo -> OptimisationLevelwithOptimization lbi :: LocalBuildInfolbi of
           NoOptimisation -> [] :: [a][]
           _              -> ["-optc-O2"])
     (++) :: [a] -> [a] -> [a]++ ["-odir", odir :: FilePathodir]

mkGHCiLibName :: PackageIdentifier -> String
mkGHCiLibName lib = "HS" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay lib :: Librarylib (<.>) :: FilePath -> String -> FilePath<.> "o"

-- -----------------------------------------------------------------------------
-- Installing

-- |Install executables for GHC.
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 dir -> dirbindir installDirs :: InstallDirs FilePathinstallDirs
  createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue binDir :: FilePathbinDir
  let exeFileName = exeName :: Executable -> StringexeName exe :: Executableexe (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
      fixedExeBaseName = progprefix :: FilePathprogprefix (++) :: [a] -> [a] -> [a]++ exeName :: Executable -> StringexeName exe :: Executableexe (++) :: [a] -> [a] -> [a]++ progsuffix :: FilePathprogsuffix
      installBinary dest = do
          installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile verbosity :: Verbosityverbosity
            (buildPref :: FilePathbuildPref (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe (</>) :: FilePath -> FilePath -> FilePath</> exeFileName :: FilePathexeFileName)
            (dest :: FilePathdest (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension)
          stripExe ::
  Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()stripExe verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi exeFileName :: FilePathexeFileName (dest :: FilePathdest (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension)
  installBinary :: FilePath -> IO ()installBinary (binDir :: FilePathbinDir (</>) :: FilePath -> FilePath -> FilePath</> fixedExeBaseName :: [Char]fixedExeBaseName)

stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
stripExe verbosity lbi name path = when :: Monad m => Bool -> m () -> m ()when (stripExes :: LocalBuildInfo -> BoolstripExes lbi :: LocalBuildInfolbi) ($) :: (a -> b) -> a -> b$
  case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram stripProgram :: ProgramstripProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
    Just strip -> rawSystemProgram ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity strip :: ConfiguredProgramstrip args :: [ProgArg]args
    Nothing    -> unless :: Monad m => Bool -> m () -> m ()unless (buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== Windows :: OSWindows) ($) :: (a -> b) -> a -> b$
                  -- Don't bother warning on windows, we don't expect them to
                  -- have the strip program anyway.
                  warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Unable to strip executable '" (++) :: [a] -> [a] -> [a]++ name :: FilePathname
                                (++) :: [a] -> [a] -> [a]++ "' (missing the 'strip' program)"
  where
    args = path :: FilePathpath (:) :: a -> [a] -> [a]: case buildOS :: OSbuildOS of
       OSX -> ["-x"] -- By default, stripping the ghc binary on at least
                     -- some OS X installations causes:
                     --     HSbase-3.0.o: unknown symbol `_environ'"
                     -- The -x flag fixes that.
       _   -> [] :: [a][]

-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib    :: Verbosity
              -> LocalBuildInfo
              -> FilePath  -- ^install location
              -> FilePath  -- ^install location for dynamic librarys
              -> FilePath  -- ^Build location
              -> PackageDescription
              -> Library
              -> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
  -- copy .hi files over:
  let copy src dst n = do
        createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue dst :: FilePathdst
        installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity (src :: FilePathsrc (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn) (dst :: FilePathdst (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn)
      copyModuleFiles ext =
        findModuleFiles ::
  [FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)]findModuleFiles [builtDir :: FilePathbuiltDir] [ext :: Extensionext] (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
          (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= installOrdinaryFiles ::
  Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()installOrdinaryFiles verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir
  ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "hi"
  ifProf :: IO () -> IO ()ifProf    ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "p_hi"
  hcrFiles <- findModuleFiles ::
  [FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)]findModuleFiles (builtDir :: FilePathbuiltDir (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib)) ["hcr"] (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
  flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ hcrFiles :: [(FilePath, FilePath)]hcrFiles ($) :: (a -> b) -> a -> b$ \(srcBase, srcFile) -> runLhc :: [ProgArg] -> IO ()runLhc ["--install-library", srcBase :: FilePathsrcBase (</>) :: FilePath -> FilePath -> FilePath</> srcFile :: FilePathsrcFile]

  -- copy the built library files over:
  ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir vanillaLibName :: StringvanillaLibName
  ifProf :: IO () -> IO ()ifProf    ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir profileLibName :: StringprofileLibName
  ifGHCi :: IO () -> IO ()ifGHCi    ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir targetDir :: FilePathtargetDir ghciLibName :: StringghciLibName
  ifShared :: IO () -> IO ()ifShared  ($) :: (a -> b) -> a -> b$ copy :: FilePath -> FilePath -> FilePath -> IO ()copy builtDir :: FilePathbuiltDir dynlibTargetDir :: FilePathdynlibTargetDir sharedLibName :: StringsharedLibName

  -- run ranlib if necessary:
  ifVanilla :: IO () -> IO ()ifVanilla ($) :: (a -> b) -> a -> b$ updateLibArchive ::
  Verbosity -> LocalBuildInfo -> FilePath -> IO ()updateLibArchive verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi
                               (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> vanillaLibName :: StringvanillaLibName)
  ifProf :: IO () -> IO ()ifProf    ($) :: (a -> b) -> a -> b$ updateLibArchive ::
  Verbosity -> LocalBuildInfo -> FilePath -> IO ()updateLibArchive verbosity :: Verbosityverbosity lbi :: LocalBuildInfolbi
                               (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> profileLibName :: StringprofileLibName)

  where
    vanillaLibName = mkLibName :: PackageIdentifier -> StringmkLibName pkgid :: PackageIdentifierpkgid
    profileLibName = mkProfLibName :: PackageIdentifier -> StringmkProfLibName pkgid :: PackageIdentifierpkgid
    ghciLibName    = mkGHCiLibName :: PackageIdentifier -> StringmkGHCiLibName pkgid :: PackageIdentifierpkgid
    sharedLibName  = mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid (compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))

    pkgid          = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: InstalledPackageInfopkg

    hasLib    = not :: Bool -> Boolnot ($) :: (a -> b) -> a -> b$ null :: [a] -> Boolnull (libModules :: Library -> [ModuleName]libModules lib :: Librarylib)
                   (&&) :: Bool -> Bool -> Bool&& null :: [a] -> Boolnull (cSources :: BuildInfo -> [FilePath]cSources (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib))
    ifVanilla = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withVanillaLib :: LocalBuildInfo -> BoolwithVanillaLib lbi :: LocalBuildInfolbi)
    ifProf    = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withProfLib :: LocalBuildInfo -> BoolwithProfLib    lbi :: LocalBuildInfolbi)
    ifGHCi    = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withGHCiLib :: LocalBuildInfo -> BoolwithGHCiLib    lbi :: LocalBuildInfolbi)
    ifShared  = when :: Monad m => Bool -> m () -> m ()when (hasLib :: BoolhasLib (&&) :: Bool -> Bool -> Bool&& withSharedLib :: LocalBuildInfo -> BoolwithSharedLib  lbi :: LocalBuildInfolbi)

    runLhc    = rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity lhcProgram :: ProgramlhcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)

-- | use @ranlib@ or @ar -s@ to build an index. This is necessary on systems
-- like MacOS X. If we can't find those, don't worry too much about it.
--
updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
updateLibArchive verbosity lbi path =
  case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ranlibProgram :: ProgramranlibProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
    Just ranlib -> rawSystemProgram ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ranlib :: ConfiguredProgramranlib [path :: FilePathpath]
    Nothing     -> case lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) of
      Just ar   -> rawSystemProgram ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ar :: ConfiguredProgramar ["-s", path :: FilePathpath]
      Nothing   -> warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$
                        "Unable to generate a symbol index for the static "
                     (++) :: [a] -> [a] -> [a]++ "library '" (++) :: [a] -> [a] -> [a]++ path :: FilePathpath
                     (++) :: [a] -> [a] -> [a]++ "' (missing the 'ranlib' and 'ar' programs)"

-- -----------------------------------------------------------------------------
-- Registering

registerPackage
  :: Verbosity
  -> InstalledPackageInfo
  -> PackageDescription
  -> LocalBuildInfo
  -> Bool
  -> PackageDBStack
  -> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
  let Just lhcPkg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram lhcPkgProgram :: ProgramlhcPkgProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
  reregister ::
  Verbosity
  -> ConfiguredProgram
  -> PackageDBStack
  -> Either FilePath InstalledPackageInfo
  -> IO ()HcPkg.reregister verbosity :: Verbosityverbosity lhcPkg :: ConfiguredProgramlhcPkg packageDbs :: PackageDBStackpackageDbs (Right :: b -> Either a bRight installedPkgInfo :: InstalledPackageInfoinstalledPkgInfo)