-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.GHC
-- 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.GHC (
        configure, getInstalledPackages,
        buildLib, buildExe,
        installLib, installExe,
        libAbiHash,
        registerPackage,
        ghcOptions,
        ghcVerbosityOptions,
        ghcPackageDbOptions,
        ghcLibDir,
 ) where

import qualified Distribution.Simple.GHC.IPI641 as IPI641
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import Distribution.PackageDescription as PD
         ( PackageDescription(..), BuildInfo(..), Executable(..)
         , Library(..), libModules, hcOptions, usedExtensions, allExtensions )
import Distribution.InstalledPackageInfo
         ( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
                                ( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex (PackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
         ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
         , absoluteInstallDirs )
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
         ( PackageIdentifier, Package(..), PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
         ( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
         , ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
         , rawSystemProgramStdout, rawSystemProgramStdoutConf
         , requireProgramVersion, requireProgram, getProgramOutput
         , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
         , ghcProgram, ghcPkgProgram, hsc2hsProgram
         , arProgram, ranlibProgram, ldProgram
         , gccProgram, stripProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar    as Ar
import qualified Distribution.Simple.Program.Ld    as Ld
import Distribution.Simple.Compiler
         ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
         , OptimisationLevel(..), PackageDB(..), PackageDBStack
         , Flag, languageToFlags, extensionsToFlags )
import Distribution.Version
         ( Version(..), anyVersion, orLaterVersion )
import Distribution.System
         ( OS(..), buildOS )
import Distribution.Verbosity
import Distribution.Text
         ( display, simpleParse )
import Language.Haskell.Extension (Language(..), Extension(..), KnownExtension(..))

import Control.Monad            ( unless, when, liftM )
import Data.Char                ( isSpace )
import Data.List
import Data.Maybe               ( catMaybes )
import Data.Monoid              ( Monoid(..) )
import System.Directory
         ( removeFile, getDirectoryContents, doesFileExist
         , getTemporaryDirectory )
import System.FilePath          ( (</>), (<.>), takeExtension,
                                  takeDirectory, replaceExtension, splitExtension )
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 conf0 = do

  (ghcProg, ghcVersion, conf1) <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram
      (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [6,4] [] :: [a][]))
      (userMaybeSpecifyPath ::
  String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "ghc" hcPath :: Maybe FilePathhcPath conf0 :: ProgramConfigurationconf0)

  -- This is slightly tricky, we have to configure ghc first, then we use the
  -- location of ghc to help find ghc-pkg in the case that the user did not
  -- specify the location of ghc-pkg directly:
  (ghcPkgProg, ghcPkgVersion, conf2) <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity ghcPkgProgram :: ProgramghcPkgProgram {
      programFindLocation = guessGhcPkgFromGhcPath ::
  ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessGhcPkgFromGhcPath ghcProg :: ConfiguredProgramghcProg
    }
    anyVersion :: VersionRangeanyVersion (userMaybeSpecifyPath ::
  String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "ghc-pkg" hcPkgPath :: Maybe FilePathhcPkgPath conf1 :: ProgramDbconf1)

  when :: Monad m => Bool -> m () -> m ()when (ghcVersion :: VersionghcVersion (/=) :: Eq a => a -> a -> Bool/= ghcPkgVersion :: VersionghcPkgVersion) ($) :: (a -> b) -> a -> b$ die :: String -> IO adie ($) :: (a -> b) -> a -> b$
       "Version mismatch between ghc and ghc-pkg: "
    (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ghcVersion :: VersionghcVersion (++) :: [a] -> [a] -> [a]++ " "
    (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath ghcPkgProg :: ConfiguredProgramghcPkgProg (++) :: [a] -> [a] -> [a]++ " is version " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ghcPkgVersion :: VersionghcPkgVersion

  -- Likewise we try to find the matching hsc2hs program.
  let hsc2hsProgram' = hsc2hsProgram :: Programhsc2hsProgram {
                           programFindLocation = guessHsc2hsFromGhcPath ::
  ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessHsc2hsFromGhcPath ghcProg :: ConfiguredProgramghcProg
                       }
      conf3 = addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram hsc2hsProgram' :: Programhsc2hsProgram' conf2 :: ProgramDbconf2

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

  ghcInfo <- if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,7] [] :: [a][]
             then do xs <- getProgramOutput ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringgetProgramOutput verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ["--info"]
                     case reads :: Read a => ReadS areads xs :: Stringxs of
                         [(i, ss)]
                          | all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolisSpace ss :: Stringss ->
                             return :: Monad m => forall a. a -> m areturn i :: [(String, String)]i
                         _ ->
                             die :: String -> IO adie "Can't parse --info output of GHC"
             else return :: Monad m => forall a. a -> m areturn [] :: [a][]

  let comp = Compiler {
        compilerId             = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId GHC :: CompilerFlavorGHC ghcVersion :: VersionghcVersion,
        compilerLanguages      = languages :: [(Language, Flag)]languages,
        compilerExtensions     = extensions :: [(Extension, Flag)]extensions
      }
      conf4 = configureToolchain ::
  ConfiguredProgram
  -> [(String, String)]
  -> ProgramConfiguration
  -> ProgramConfigurationconfigureToolchain ghcProg :: ConfiguredProgramghcProg ghcInfo :: [(String, String)]ghcInfo conf3 :: ProgramDbconf3 -- configure gcc and ld
  return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf4 :: ProgramConfigurationconf4)

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
-- for a versioned or unversioned ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessToolFromGhcPath :: FilePath -> ConfiguredProgram -> Verbosity
                     -> IO (Maybe FilePath)
guessToolFromGhcPath tool ghcProg verbosity
  = do let path              = programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg
           dir               = takeDirectory :: FilePath -> FilePathtakeDirectory path :: FilePathpath
           versionSuffix     = takeVersionSuffix :: FilePath -> StringtakeVersionSuffix (dropExeExtension :: FilePath -> FilePathdropExeExtension path :: FilePathpath)
           guessNormal       = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> tool :: FilePathtool (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
           guessGhcVersioned = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> (tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ "-ghc" (++) :: [a] -> [a] -> [a]++ versionSuffix :: StringversionSuffix) (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
           guessVersioned    = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> (tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ versionSuffix :: StringversionSuffix) (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
           guesses | null :: [a] -> Boolnull versionSuffix :: StringversionSuffix = [guessNormal :: FilePathguessNormal]
                   | otherwise :: Boolotherwise          = [guessGhcVersioned :: FilePathguessGhcVersioned,
                                           guessVersioned :: FilePathguessVersioned,
                                           guessNormal :: FilePathguessNormal]
       info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "looking for tool " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ " near compiler in " (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir
       exists <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM doesFileExist :: FilePath -> IO BooldoesFileExist guesses :: [FilePath]guesses
       case [ file :: FilePathfile | (file, True) <- zip :: [a] -> [b] -> [(a, b)]zip guesses :: [FilePath]guesses exists :: [Bool]exists ] of
         [] -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing
         (fp:_) -> do info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "found " (++) :: [a] -> [a] -> [a]++ tool :: FilePathtool (++) :: [a] -> [a] -> [a]++ " in " (++) :: [a] -> [a] -> [a]++ fp :: FilePathfp
                      return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust fp :: FilePathfp)

  where takeVersionSuffix :: FilePath -> String
        takeVersionSuffix = reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. takeWhile :: (a -> Bool) -> [a] -> [a]takeWhile (elem :: Eq a => a -> [a] -> Bool`elem ` "0123456789.-") (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse

        dropExeExtension :: FilePath -> FilePath
        dropExeExtension filepath =
          case splitExtension :: FilePath -> (String, String)splitExtension filepath :: FilePathfilepath of
            (filepath', extension) | extension :: Stringextension (==) :: Eq a => a -> a -> Bool== exeExtension :: StringexeExtension -> filepath' :: Stringfilepath'
                                   | otherwise :: Boolotherwise                 -> filepath :: FilePathfilepath

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
guessGhcPkgFromGhcPath = guessToolFromGhcPath ::
  FilePath -> ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessToolFromGhcPath "ghc-pkg"

-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
-- hsc2hs in the same dir, that is:
--
-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
--
guessHsc2hsFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
guessHsc2hsFromGhcPath = guessToolFromGhcPath ::
  FilePath -> ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)guessToolFromGhcPath "hsc2hs"

-- | Adjust the way we find and configure gcc and ld
--
configureToolchain :: ConfiguredProgram -> [(String, String)]
                                        -> ProgramConfiguration
                                        -> ProgramConfiguration
configureToolchain ghcProg ghcInfo =
    addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram gccProgram :: ProgramgccProgram {
      programFindLocation = findProg ::
  Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)findProg gccProgram :: ProgramgccProgram
                              [ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
                                  then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "gcc.exe"
                                  else 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
                              [ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
                                  then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe"
                                  else libDir :: FilePathlibDir      (</>) :: FilePath -> FilePath -> FilePath</> "ld.exe" ],
      programPostConf     = configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd
    }
  (.) :: (b -> c) -> (a -> b) -> a -> c. addKnownProgram :: Program -> ProgramDb -> ProgramDbaddKnownProgram arProgram :: ProgramarProgram {
      programFindLocation = findProg ::
  Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)findProg arProgram :: ProgramarProgram
                              [ if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,12] [] :: [a][]
                                  then mingwBinDir :: FilePathmingwBinDir (</>) :: FilePath -> FilePath -> FilePath</> "ar.exe"
                                  else libDir :: FilePathlibDir      (</>) :: FilePath -> FilePath -> FilePath</> "ar.exe" ]
    }
  where
    Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
    compilerDir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
    baseDir     = takeDirectory :: FilePath -> FilePathtakeDirectory compilerDir :: FilePathcompilerDir
    mingwBinDir = baseDir :: FilePathbaseDir (</>) :: FilePath -> FilePath -> FilePath</> "mingw" (</>) :: FilePath -> FilePath -> FilePath</> "bin"
    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 locations
      | isWindows :: BoolisWindows = \verbosity -> look :: [FilePath] -> Verbosity -> IO (Maybe FilePath)look locations :: [FilePath]locations verbosity :: Verbosityverbosity
      | otherwise :: Boolotherwise = programFindLocation :: Program -> Verbosity -> IO (Maybe FilePath)programFindLocation prog :: Programprog
      where
        look [] verbosity = 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
        look (f:fs) verbosity = do
          exists <- doesFileExist :: FilePath -> IO BooldoesFileExist f :: FilePathf
          if exists :: [Bool]exists then return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust f :: FilePathf)
                    else look :: [FilePath] -> Verbosity -> IO (Maybe FilePath)look fs :: [FilePath]fs verbosity :: Verbosityverbosity

    ccFlags        = getFlags :: Read a => String -> [a]getFlags "C compiler flags"
    gccLinkerFlags = getFlags :: Read a => String -> [a]getFlags "Gcc Linker flags"
    ldLinkerFlags  = getFlags :: Read a => String -> [a]getFlags "Ld Linker flags"

    getFlags key = case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup key :: Stringkey ghcInfo :: [(String, String)]ghcInfo of
                   Nothing -> [] :: [a][]
                   Just flags ->
                       case reads :: Read a => ReadS areads flags :: Stringflags of
                       [(args, "")] -> args :: [a]args
                       _ -> [] :: [a][] -- XXX Should should be an error really

    configureGcc :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
    configureGcc v cp = liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM ((++) :: [a] -> [a] -> [a]++ (ccFlags :: [ProgArg]ccFlags (++) :: [a] -> [a] -> [a]++ gccLinkerFlags :: [ProgArg]gccLinkerFlags))
                      ($) :: (a -> b) -> a -> b$ configureGcc' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureGcc' v :: Verbosityv cp :: ConfiguredProgramcp

    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
          -- Pre GHC 6.12, that meant we should add these flags to tell
          -- ghc's gcc where it lives and thus where gcc can find its
          -- various files:
          FoundOnSystem {}
           | ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][] ->
              return :: Monad m => forall a. a -> m areturn ["-B" (++) :: [a] -> [a] -> [a]++ libDir :: FilePathlibDir, "-I" (++) :: [a] -> [a] -> [a]++ includeDir :: FilePathincludeDir]
          _ -> return :: Monad m => forall a. a -> m areturn [] :: [a][]
      | otherwise :: Boolotherwise = \_ _   -> return :: Monad m => forall a. a -> m areturn [] :: [a][]

    configureLd :: Verbosity -> ConfiguredProgram -> IO [ProgArg]
    configureLd v cp = liftM :: Monad m => (a1 -> r) -> m a1 -> m rliftM ((++) :: [a] -> [a] -> [a]++ ldLinkerFlags :: [ProgArg]ldLinkerFlags) ($) :: (a -> b) -> a -> b$ configureLd' :: Verbosity -> ConfiguredProgram -> IO [ProgArg]configureLd' v :: Verbosityv cp :: ConfiguredProgramcp

    -- 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 ghcProg :: ConfiguredProgramghcProg ["-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 _ ghcProg
  -- TODO: should be using --supported-languages rather than hard coding
  | ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [7] [] :: [a][] = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98,   "-XHaskell98")
                                          ,(Haskell2010 :: LanguageHaskell2010, "-XHaskell2010")]
  | otherwise :: Boolotherwise                    = return :: Monad m => forall a. a -> m areturn [(Haskell98 :: LanguageHaskell98,   "")]
  where
    Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg

getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions verbosity ghcProg
  | ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,7] [] :: [a][] = do

    str <- rawSystemStdout :: Verbosity -> FilePath -> [String] -> IO StringrawSystemStdout verbosity :: Verbosityverbosity (programPath :: ConfiguredProgram -> FilePathprogramPath ghcProg :: ConfiguredProgramghcProg)
              ["--supported-languages"]
    let extStrs = if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [7] [] :: [a][]
                  then lines :: String -> [String]lines str :: Stringstr
                  else -- Older GHCs only gave us either Foo or NoFoo,
                       -- so we have to work out the other one ourselves
                       [ extStr'' :: StringextStr''
                       | extStr <- lines :: String -> [String]lines str :: Stringstr
                       , let extStr' = case extStr :: StringextStr of
                                       'N' : 'o' : xs -> xs :: Stringxs
                                       _              -> "No" (++) :: [a] -> [a] -> [a]++ extStr :: StringextStr
                       , extStr'' <- [extStr :: StringextStr, extStr' :: [Char]extStr']
                       ]
    let extensions0 = [ (ext :: Extensionext, "-X" (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay ext :: Extensionext)
                      | Just ext <- map :: (a -> b) -> [a] -> [b]map simpleParse :: Text a => String -> Maybe asimpleParse extStrs :: [String]extStrs ]
        extensions1 = if ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,8]  [] :: [a][] (&&) :: Bool -> Bool -> Bool&&
                         ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool<  Version :: [Int] -> [String] -> VersionVersion [6,10] [] :: [a][]
                      then -- ghc-6.8 introduced RecordPuns however it
                           -- should have been NamedFieldPuns. We now
                           -- encourage packages to use NamedFieldPuns
                           -- so for compatability we fake support for
                           -- it in ghc-6.8 by making it an alias for
                           -- the old RecordPuns extension.
                           (EnableExtension :: KnownExtension -> ExtensionEnableExtension  NamedFieldPuns :: KnownExtensionNamedFieldPuns, "-XRecordPuns") (:) :: a -> [a] -> [a]:
                           (DisableExtension :: KnownExtension -> ExtensionDisableExtension NamedFieldPuns :: KnownExtensionNamedFieldPuns, "-XNoRecordPuns") (:) :: a -> [a] -> [a]:
                           extensions0 :: [(Extension, [Char])]extensions0
                      else extensions0 :: [(Extension, [Char])]extensions0
        extensions2 = if ghcVersion :: VersionghcVersion (<) :: Ord a => a -> a -> Bool<  Version :: [Int] -> [String] -> VersionVersion [7,1] [] :: [a][]
                      then -- ghc-7.2 split NondecreasingIndentation off
                           -- into a proper extension. Before that it
                           -- was always on.
                           (EnableExtension :: KnownExtension -> ExtensionEnableExtension  NondecreasingIndentation :: KnownExtensionNondecreasingIndentation, "") (:) :: a -> [a] -> [a]:
                           (DisableExtension :: KnownExtension -> ExtensionDisableExtension NondecreasingIndentation :: KnownExtensionNondecreasingIndentation, "") (:) :: a -> [a] -> [a]:
                           extensions1 :: [(Extension, [Char])]extensions1
                      else extensions1 :: [(Extension, [Char])]extensions1
    return :: Monad m => forall a. a -> m areturn extensions2 :: [(Extension, [Char])]extensions2

  | otherwise :: Boolotherwise = return :: Monad m => forall a. a -> m areturn oldLanguageExtensions :: [(Extension, Flag)]oldLanguageExtensions

  where
    Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg

-- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags
oldLanguageExtensions :: [(Extension, Flag)]
oldLanguageExtensions =
    let doFlag (f, (enable, disable)) = [(EnableExtension :: KnownExtension -> ExtensionEnableExtension  f :: FilePathf, enable :: tenable),
                                         (DisableExtension :: KnownExtension -> ExtensionDisableExtension f :: FilePathf, disable :: tdisable)]
        fglasgowExts = ("-fglasgow-exts",
                        "") -- This is wrong, but we don't want to turn
                            -- all the extensions off when asked to just
                            -- turn one off
        fFlag flag = ("-f" (++) :: [a] -> [a] -> [a]++ flag :: [Char]flag, "-fno-" (++) :: [a] -> [a] -> [a]++ flag :: [Char]flag)
    in concatMap :: (a -> [b]) -> [a] -> [b]concatMap doFlag :: (KnownExtension, (t, t)) -> [(Extension, t)]doFlag
    [(OverlappingInstances :: KnownExtensionOverlappingInstances       , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-overlapping-instances")
    ,(TypeSynonymInstances :: KnownExtensionTypeSynonymInstances       , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(TemplateHaskell :: KnownExtensionTemplateHaskell            , fFlag :: [Char] -> ([Char], [Char])fFlag "th")
    ,(ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface   , fFlag :: [Char] -> ([Char], [Char])fFlag "ffi")
    ,(MonomorphismRestriction :: KnownExtensionMonomorphismRestriction    , fFlag :: [Char] -> ([Char], [Char])fFlag "monomorphism-restriction")
    ,(MonoPatBinds :: KnownExtensionMonoPatBinds               , fFlag :: [Char] -> ([Char], [Char])fFlag "mono-pat-binds")
    ,(UndecidableInstances :: KnownExtensionUndecidableInstances       , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-undecidable-instances")
    ,(IncoherentInstances :: KnownExtensionIncoherentInstances        , fFlag :: [Char] -> ([Char], [Char])fFlag "allow-incoherent-instances")
    ,(Arrows :: KnownExtensionArrows                     , fFlag :: [Char] -> ([Char], [Char])fFlag "arrows")
    ,(Generics :: KnownExtensionGenerics                   , fFlag :: [Char] -> ([Char], [Char])fFlag "generics")
    ,(ImplicitPrelude :: KnownExtensionImplicitPrelude            , fFlag :: [Char] -> ([Char], [Char])fFlag "implicit-prelude")
    ,(ImplicitParams :: KnownExtensionImplicitParams             , fFlag :: [Char] -> ([Char], [Char])fFlag "implicit-params")
    ,(CPP :: KnownExtensionCPP                        , ("-cpp", ""{- Wrong -}))
    ,(BangPatterns :: KnownExtensionBangPatterns               , fFlag :: [Char] -> ([Char], [Char])fFlag "bang-patterns")
    ,(KindSignatures :: KnownExtensionKindSignatures             , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(RecursiveDo :: KnownExtensionRecursiveDo                , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(ParallelListComp :: KnownExtensionParallelListComp           , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(MultiParamTypeClasses :: KnownExtensionMultiParamTypeClasses      , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(FunctionalDependencies :: KnownExtensionFunctionalDependencies     , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(Rank2Types :: KnownExtensionRank2Types                 , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(RankNTypes :: KnownExtensionRankNTypes                 , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(PolymorphicComponents :: KnownExtensionPolymorphicComponents      , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(ExistentialQuantification :: KnownExtensionExistentialQuantification  , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(ScopedTypeVariables :: KnownExtensionScopedTypeVariables        , fFlag :: [Char] -> ([Char], [Char])fFlag "scoped-type-variables")
    ,(FlexibleContexts :: KnownExtensionFlexibleContexts           , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(FlexibleInstances :: KnownExtensionFlexibleInstances          , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(EmptyDataDecls :: KnownExtensionEmptyDataDecls             , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(PatternGuards :: KnownExtensionPatternGuards              , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(GeneralizedNewtypeDeriving :: KnownExtensionGeneralizedNewtypeDeriving , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(MagicHash :: KnownExtensionMagicHash                  , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(UnicodeSyntax :: KnownExtensionUnicodeSyntax              , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(PatternSignatures :: KnownExtensionPatternSignatures          , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(UnliftedFFITypes :: KnownExtensionUnliftedFFITypes           , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(LiberalTypeSynonyms :: KnownExtensionLiberalTypeSynonyms        , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(TypeOperators :: KnownExtensionTypeOperators              , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(GADTs :: KnownExtensionGADTs                      , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(RelaxedPolyRec :: KnownExtensionRelaxedPolyRec             , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(ExtendedDefaultRules :: KnownExtensionExtendedDefaultRules       , fFlag :: [Char] -> ([Char], [Char])fFlag "extended-default-rules")
    ,(UnboxedTuples :: KnownExtensionUnboxedTuples              , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(DeriveDataTypeable :: KnownExtensionDeriveDataTypeable         , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ,(ConstrainedClassMethods :: KnownExtensionConstrainedClassMethods    , fglasgowExts :: ([Char], [Char])fglasgowExts)
    ]

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
  topDir <- ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePathghcLibDir' verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg
  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$! hackRtsPackage :: PackageIndex -> PackageIndexhackRtsPackage (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 ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf

    hackRtsPackage index =
      case lookupPackageName ::
  PackageIndex -> PackageName -> [(Version, [InstalledPackageInfo])]PackageIndex.lookupPackageName index :: PackageIndexindex (PackageName :: String -> PackageNamePackageName "rts") of
        [(_,[rts])]
           -> insert :: InstalledPackageInfo -> PackageIndex -> PackageIndexPackageIndex.insert (removeMingwIncludeDir ::
  InstalledPackageInfo -> InstalledPackageInforemoveMingwIncludeDir rts :: InstalledPackageInforts) index :: PackageIndexindex
        _  -> index :: PackageIndexindex -- No (or multiple) ghc rts package is registered!!
                    -- Feh, whatever, the ghc testsuite does some crazy stuff.

ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
ghcLibDir verbosity lbi =
    (reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap`
     rawSystemProgramStdoutConf ::
  Verbosity
  -> Program
  -> ProgramConfiguration
  -> [ProgArg]
  -> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ["--print-libdir"]

ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcLibDir' verbosity ghcProg =
    (reverse :: [a] -> [a]reverse (.) :: (b -> c) -> (a -> b) -> a -> c. dropWhile :: (a -> Bool) -> [a] -> [a]dropWhile isSpace :: Char -> BoolisSpace (.) :: (b -> c) -> (a -> b) -> a -> c. reverse :: [a] -> [a]reverse) fmap :: Functor f => forall a b. (a -> b) -> f a -> f b`fmap`
     rawSystemProgramStdout ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO StringrawSystemProgramStdout verbosity :: Verbosityverbosity ghcProg :: ConfiguredProgramghcProg ["--print-libdir"]

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"

-- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
-- breaks when you want to use a different gcc, so we need to filter
-- it out.
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
    let ids = includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs pkg :: InstalledPackageInfopkg
        ids' = filter :: (a -> Bool) -> [a] -> [a]filter (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. ("mingw" isSuffixOf :: Eq a => [a] -> [a] -> Bool`isSuffixOf`)) ids :: [FilePath]ids
    in pkg :: InstalledPackageInfopkg { InstalledPackageInfo.includeDirs = ids' :: [[Char]]ids' }

-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
                     -> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
  | ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,9] [] :: [a][] =
  sequence :: Monad m => [m a] -> m [a]sequence
    [ do pkgs <- dump ::
  Verbosity
  -> ConfiguredProgram
  -> PackageDB
  -> IO [InstalledPackageInfo]HcPkg.dump verbosity :: Verbosityverbosity ghcPkgProg :: ConfiguredProgramghcPkgProg packagedb :: PackageDBpackagedb
         return :: Monad m => forall a. a -> m areturn (packagedb :: PackageDBpackagedb, pkgs :: [InstalledPackageInfo]pkgs)
    | packagedb <- packagedbs :: PackageDBStackpackagedbs ]

  where
    Just ghcPkgProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcPkgProgram :: ProgramghcPkgProgram conf :: ProgramConfigurationconf
    Just ghcProg    = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf
    Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg

getInstalledPackages' verbosity packagedbs conf = do
    str <- rawSystemProgramStdoutConf ::
  Verbosity
  -> Program
  -> ProgramConfiguration
  -> [ProgArg]
  -> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcPkgProgram :: ProgramghcPkgProgram conf :: ProgramConfigurationconf ["list"]
    let pkgFiles = [ init :: [a] -> [a]init line :: Stringline | line <- lines :: String -> [String]lines str :: Stringstr, last :: [a] -> alast line :: Stringline (==) :: Eq a => a -> a -> Bool== ':' ]
        dbFile packagedb = case (packagedb :: PackageDBpackagedb, pkgFiles :: [[Char]]pkgFiles) of
          (GlobalPackageDB, global:_)      -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust global :: [Char]global
          (UserPackageDB,  _global:user:_) -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust user :: [Char]user
          (UserPackageDB,  _global:_)      -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Nothing :: Maybe aNothing
          (SpecificPackageDB specific, _)  -> return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Just :: a -> Maybe aJust specific :: FilePathspecific
          _ -> die :: String -> IO adie "cannot read ghc-pkg package listing"
    pkgFiles' <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM dbFile :: PackageDB -> IO (Maybe [Char])dbFile packagedbs :: PackageDBStackpackagedbs
    sequence :: Monad m => [m a] -> m [a]sequence [ withFileContents :: FilePath -> (String -> IO a) -> IO awithFileContents file :: FilePathfile ($) :: (a -> b) -> a -> b$ \content -> do
                  pkgs <- readPackages :: [Char] -> String -> IO [InstalledPackageInfo]readPackages file :: FilePathfile content :: Stringcontent
                  return :: Monad m => forall a. a -> m areturn (db :: PackageDBdb, pkgs :: [InstalledPackageInfo]pkgs)
             | (db , Just file) <- zip :: [a] -> [b] -> [(a, b)]zip packagedbs :: PackageDBStackpackagedbs pkgFiles' :: [Maybe [Char]]pkgFiles' ]
  where
    -- Depending on the version of ghc we use a different type's Read
    -- instance to parse the package file and then convert.
    -- It's a bit yuck. But that's what we get for using Read/Show.
    readPackages
      | ghcVersion :: VersionghcVersion (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,4,2] [] :: [a][]
      = \file content -> case reads :: Read a => ReadS areads content :: Stringcontent of
          [(pkgs, _)] -> return :: Monad m => forall a. a -> m areturn (map :: (a -> b) -> [a] -> [b]map toCurrent :: InstalledPackageInfo -> InstalledPackageInfoIPI642.toCurrent pkgs :: [InstalledPackageInfo]pkgs)
          _           -> failToRead :: [Char] -> IO afailToRead file :: FilePathfile
      | otherwise :: Boolotherwise
      = \file content -> case reads :: Read a => ReadS areads content :: Stringcontent of
          [(pkgs, _)] -> return :: Monad m => forall a. a -> m areturn (map :: (a -> b) -> [a] -> [b]map toCurrent :: InstalledPackageInfo -> InstalledPackageInfoIPI641.toCurrent pkgs :: [InstalledPackageInfo]pkgs)
          _           -> failToRead :: [Char] -> IO afailToRead file :: FilePathfile
    Just ghcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram ghcProgram :: ProgramghcProgram conf :: ProgramConfigurationconf
    Just ghcVersion = programVersion :: ConfiguredProgram -> Maybe VersionprogramVersion ghcProg :: ConfiguredProgramghcProg
    failToRead file = die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "cannot read ghc package database " (++) :: [a] -> [a] -> [a]++ file :: FilePathfile

substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
substTopDir topDir ipo
 = ipo :: InstalledPackageInfoipo {
       InstalledPackageInfo.importDirs
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (importDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.importDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.libraryDirs
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (libraryDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.libraryDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.includeDirs
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (includeDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.includeDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.frameworkDirs
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (frameworkDirs :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.frameworkDirs ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.haddockInterfaces
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (haddockInterfaces :: InstalledPackageInfo_ m -> [FilePath]InstalledPackageInfo.haddockInterfaces ipo :: InstalledPackageInfoipo),
       InstalledPackageInfo.haddockHTMLs
           = map :: (a -> b) -> [a] -> [b]map f :: FilePathf (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 GHC.
--
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 ghcProgram :: ProgramghcProgram (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)
      comp = compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi

  libBi <- hackThreadedFlag ::
  Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfohackThreadedFlag verbosity :: Verbosityverbosity
             comp :: Compilercomp (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 =
             "--make"
          (:) :: a -> [a] -> [a]:  ["-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)
      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 ghcArgs :: [[Char]]ghcArgs)
       ifProfLib :: IO () -> IO ()ifProfLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg ghcArgsProf :: [[Char]]ghcArgsProf)
       ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg 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
  -> Bool
  -> Bool
  -> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi pref :: FilePathpref
                                                        filename :: FilePathfilename verbosity :: Verbosityverbosity
                                                        False :: BoolFalse
                                                        (withProfLib :: LocalBuildInfo -> BoolwithProfLib lbi :: LocalBuildInfolbi)
                   createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
                   runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [a]args
                   ifSharedLib :: IO () -> IO ()ifSharedLib (runGhcProg :: [ProgArg] -> IO ()runGhcProg (args :: [a]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
      libInstallPath = libdir :: InstallDirs dir -> dirlibdir ($) :: (a -> b) -> a -> b$ absoluteInstallDirs ::
  PackageDescription
  -> LocalBuildInfo
  -> CopyDest
  -> InstallDirs FilePathabsoluteInstallDirs pkg_descr :: PackageDescriptionpkg_descr lbi :: LocalBuildInfolbi NoCopyDest :: CopyDestNoCopyDest
      sharedLibInstallPath = libInstallPath :: FilePathlibInstallPath (</>) :: FilePath -> FilePath -> FilePath</> mkSharedLibName :: PackageIdentifier -> CompilerId -> StringmkSharedLibName pkgid :: PackageIdentifierpkgid
                                              (compilerId :: Compiler -> CompilerIdcompilerId (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi))

  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 staticObjectFiles =
               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
        profObjectFiles =
               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
        ghciObjFiles =
               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
        dynamicObjectFiles =
               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 ]
            -- For dynamic libs, Mac OS/X needs to know the install location
            -- at build time.
            (++) :: [a] -> [a] -> [a]++ (if buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== OSX :: OSOSX
                then ["-dylib-install-name", sharedLibInstallPath :: FilePathsharedLibInstallPath]
                else [] :: [a][])
            (++) :: [a] -> [a] -> [a]++ dynamicObjectFiles :: [FilePath]dynamicObjectFiles
            (++) :: [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]

    ifVanillaLib :: Monad m => Bool -> m () -> m ()ifVanillaLib False :: BoolFalse ($) :: (a -> b) -> a -> b$ do
      (arProg, _) <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
      createArLibArchive ::
  Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ar.createArLibArchive verbosity :: Verbosityverbosity arProg :: ConfiguredProgramarProg
        vanillaLibFilePath :: FilePathvanillaLibFilePath staticObjectFiles :: [FilePath]staticObjectFiles

    ifProfLib :: IO () -> IO ()ifProfLib ($) :: (a -> b) -> a -> b$ do
      (arProg, _) <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
      createArLibArchive ::
  Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ar.createArLibArchive verbosity :: Verbosityverbosity arProg :: ConfiguredProgramarProg
        profileLibFilePath :: FilePathprofileLibFilePath profObjectFiles :: [FilePath]profObjectFiles

    ifGHCiLib :: IO () -> IO ()ifGHCiLib ($) :: (a -> b) -> a -> b$ do
      (ldProg, _) <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity ldProgram :: ProgramldProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
      combineObjectFiles ::
  Verbosity -> ConfiguredProgram -> FilePath -> [FilePath] -> IO ()Ld.combineObjectFiles verbosity :: Verbosityverbosity ldProg :: ConfiguredProgramldProg
        ghciLibFilePath :: FilePathghciLibFilePath ghciObjFiles :: [FilePath]ghciObjFiles

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


-- | Build an executable with GHC.
--
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 ghcProgram :: ProgramghcProgram (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
  -> Bool
  -> Bool
  -> (FilePath, [String])constructCcCmdLine lbi :: LocalBuildInfolbi exeBi :: BuildInfoexeBi clbi :: ComponentLocalBuildInfoclbi
                                          exeDir :: FilePathexeDir filename :: FilePathfilename verbosity :: Verbosityverbosity
                                          (withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) (withProfExe :: LocalBuildInfo -> BoolwithProfExe lbi :: LocalBuildInfolbi)
                 createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue odir :: FilePathodir
                 runGhcProg :: [ProgArg] -> IO ()runGhcProg args :: [a]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 binArgs linkExe dynExe profExe =
             "--make"
          (:) :: a -> [a] -> [a]:  (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 :: FilePathf] | f <- frameworks :: BuildInfo -> [String]PD.frameworks exeBi :: BuildInfoexeBi]
          (++) :: [a] -> [a] -> [a]++ if dynExe :: BooldynExe
                then ["-dynamic"]
                else [] :: [a][]
          (++) :: [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 (binArgs :: Bool -> Bool -> Bool -> [[Char]]binArgs False :: BoolFalse (withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) False :: BoolFalse))

  runGhcProg :: [ProgArg] -> IO ()runGhcProg (binArgs :: Bool -> Bool -> Bool -> [[Char]]binArgs True :: BoolTrue (withDynExe :: LocalBuildInfo -> BoolwithDynExe lbi :: LocalBuildInfolbi) (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 splitSuffix = if compilerVersion :: Compiler -> VersioncompilerVersion (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (<) :: Ord a => a -> a -> Bool<
                             Version :: [Int] -> [String] -> VersionVersion [6, 11] [] :: [a][]
                          then "_split"
                          else "_" (++) :: [a] -> [a] -> [a]++ wanted_obj_ext :: Stringwanted_obj_ext (++) :: [a] -> [a] -> [a]++ "_split"
            dirs = [ pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> (toFilePath :: ModuleName -> FilePathModuleName.toFilePath x :: [Char]x (++) :: [a] -> [a] -> [a]++ splitSuffix :: [Char]splitSuffix)
                   | 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 ]

-- | Extracts a String representing a hash of the ABI of a built
-- library.  It can fail if the library has not yet been built.
--
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
           -> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity pkg_descr lbi lib clbi = do
  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
      ghcArgs =
             "--abi-hash"
          (:) :: a -> [a] -> [a]:  ["-package-name", display :: Text a => a -> Stringdisplay (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr) ]
          (++) :: [a] -> [a] -> [a]++ constructGHCCmdLine ::
  LocalBuildInfo
  -> BuildInfo
  -> ComponentLocalBuildInfo
  -> FilePath
  -> Verbosity
  -> [String]constructGHCCmdLine lbi :: LocalBuildInfolbi libBi :: BuildInfolibBi clbi :: ComponentLocalBuildInfoclbi (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi) verbosity :: Verbosityverbosity
          (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map display :: Text a => a -> Stringdisplay (exposedModules :: Library -> [ModuleName]exposedModules lib :: Librarylib)
  --
  rawSystemProgramStdoutConf ::
  Verbosity
  -> Program
  -> ProgramConfiguration
  -> [ProgArg]
  -> IO StringrawSystemProgramStdoutConf verbosity :: Verbosityverbosity ghcProgram :: ProgramghcProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ghcArgs :: [[Char]]ghcArgs


constructGHCCmdLine
        :: LocalBuildInfo
        -> BuildInfo
        -> ComponentLocalBuildInfo
        -> FilePath
        -> Verbosity
        -> [String]
constructGHCCmdLine lbi bi clbi odir verbosity =
        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]++ ["-fbuilding-cabal-package" | ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>= Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][] ]
     (++) :: [a] -> [a] -> [a]++ ghcPackageDbOptions :: PackageDBStack -> [String]ghcPackageDbOptions (withPackageDB :: LocalBuildInfo -> PackageDBStackwithPackageDB lbi :: LocalBuildInfolbi)
     (++) :: [a] -> [a] -> [a]++ ["-split-objs" | splitObjs :: LocalBuildInfo -> BoolsplitObjs lbi :: LocalBuildInfolbi ]
     (++) :: [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]++ "\"" | ghcVer :: VersionghcVer (<) :: Ord a => a -> a -> Bool< Version :: [Int] -> [String] -> VersionVersion [6,11] [] :: [a][]
                                        , inc <- includes :: BuildInfo -> [FilePath]PD.includes bi :: BuildInfobi ]
     (++) :: [a] -> [a] -> [a]++ [ "-odir",  odir :: FilePathodir, "-hidir", odir :: FilePathodir ]
     (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [ ["-stubdir", odir :: FilePathodir] | ghcVer :: VersionghcVer (>=) :: Ord a => a -> a -> Bool>=  Version :: [Int] -> [String] -> VersionVersion [6,8] [] :: [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   (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (defaultLanguage :: BuildInfo -> Maybe LanguagedefaultLanguage bi :: BuildInfobi)
     (++) :: [a] -> [a] -> [a]++ extensionsToFlags :: Compiler -> [Extension] -> [Flag]extensionsToFlags (compiler :: LocalBuildInfo -> Compilercompiler lbi :: LocalBuildInfolbi) (usedExtensions :: BuildInfo -> [Extension]usedExtensions bi :: BuildInfobi)
    where
      ghcVer = compilerVersion :: Compiler -> VersioncompilerVersion (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 :: FilePathspecific dbs :: [PackageDB]dbs
  (GlobalPackageDB:dbs)               -> "-no-user-package-conf"
                                       (:) :: a -> [a] -> [a]: concatMap :: (a -> [b]) -> [a] -> [b]concatMap specific :: FilePathspecific dbs :: [PackageDB]dbs
  _                                   -> ierror :: tierror
  where
    specific (SpecificPackageDB db) = [ "-package-conf", db :: PackageDBdb ]
    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 -> Bool -> Bool
                   ->(FilePath,[String])
constructCcCmdLine lbi bi clbi pref filename verbosity dynamic profiling
  =  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]
         -- Note: When building with profiling enabled, we pass the -prof
         -- option to ghc here when compiling C code, so that the PROFILING
         -- macro gets defined. The macro is used in ghc's Rts.h in the
         -- definitions of closure layouts (Closures.h).
         (++) :: [a] -> [a] -> [a]++ ["-dynamic" | dynamic :: Booldynamic]
         (++) :: [a] -> [a] -> [a]++ ["-prof" | profiling :: Boolprofiling])

ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
             -> FilePath -> [String]
ghcCcOptions lbi bi clbi odir
     =  ["-I" (++) :: [a] -> [a] -> [a]++ dir :: FilePathdir | dir <- odir :: FilePathodir (:) :: a -> [a] -> [a]: 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 :: [a]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 copyHelper installFun src dst n = do
        createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue dst :: FilePathdst
        installFun :: Verbosity -> FilePath -> FilePath -> IO binstallFun verbosity :: Verbosityverbosity (src :: FilePathsrc (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn) (dst :: FilePathdst (</>) :: FilePath -> FilePath -> FilePath</> n :: FilePathn)
      copy       = copyHelper ::
  (Verbosity -> FilePath -> FilePath -> IO b)
  -> FilePath
  -> FilePath
  -> FilePath
  -> IO bcopyHelper installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile
      copyShared = copyHelper ::
  (Verbosity -> FilePath -> FilePath -> IO b)
  -> FilePath
  -> FilePath
  -> FilePath
  -> IO bcopyHelper installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile
      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"
  ifShared :: IO () -> IO ()ifShared  ($) :: (a -> b) -> a -> b$ copyModuleFiles :: String -> IO ()copyModuleFiles "dyn_hi"

  -- 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$ copyShared :: FilePath -> FilePath -> FilePath -> IO ()copyShared 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)

-- | On MacOS X we have to call @ranlib@ to regenerate the archive index after
-- copying. This is because the silly MacOS X linker checks that the archive
-- index is not older than the file itself, which means simply
-- copying/installing the file breaks it!!
--
updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
updateLibArchive verbosity lbi path
  | buildOS :: OSbuildOS (==) :: Eq a => a -> a -> Bool== OSX :: OSOSX = do
    (ranlib, _) <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity ranlibProgram :: ProgramranlibProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi)
    rawSystemProgram ::
  Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity ranlib :: ConfiguredProgramranlib [path :: FilePathpath]
  | otherwise :: Boolotherwise = return :: Monad m => forall a. a -> m areturn ()


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

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