-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.NHC
-- Copyright   :  Isaac Jones 2003-2006
--                Duncan Coutts 2009
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module contains most of the NHC-specific code for configuring, building
-- and installing packages.

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

Redistribution and use in source and binary forms, with or without
modification, 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.NHC (
    configure,
    getInstalledPackages,
    buildLib,
    buildExe,
    installLib,
    installExe,
  ) where

import Distribution.Package
         ( PackageName, PackageIdentifier(..), InstalledPackageId(..)
         , packageId, packageName )
import Distribution.InstalledPackageInfo
         ( InstalledPackageInfo
         , InstalledPackageInfo_( InstalledPackageInfo, installedPackageId
                                , sourcePackageId )
         , emptyInstalledPackageInfo, parseInstalledPackageInfo )
import Distribution.PackageDescription
        ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
        , hcOptions, usedExtensions )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.LocalBuildInfo
        ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
import Distribution.Simple.BuildPaths
        ( mkLibName, objExtension, exeExtension )
import Distribution.Simple.Compiler
         ( CompilerFlavor(..), CompilerId(..), Compiler(..)
         , Flag, languageToFlags, extensionsToFlags
         , PackageDB(..), PackageDBStack )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
import Language.Haskell.Extension
         ( Language(Haskell98), Extension(..), KnownExtension(..) )
import Distribution.Simple.Program
         ( ProgramConfiguration, userMaybeSpecifyPath, programPath
         , requireProgram, requireProgramVersion, lookupProgram
         , nhcProgram, hmakeProgram, ldProgram, arProgram
         , rawSystemProgramConf )
import Distribution.Simple.Utils
        ( die, info, findFileWithExtension, findModuleFiles
        , installOrdinaryFile, installExecutableFile, installOrdinaryFiles
        , createDirectoryIfMissingVerbose, withUTF8FileContents )
import Distribution.Version
        ( Version(..), orLaterVersion )
import Distribution.Verbosity
import Distribution.Text
         ( display, simpleParse )
import Distribution.ParseUtils
         ( ParseResult(..) )

import System.FilePath
        ( (</>), (<.>), normalise, takeDirectory, dropExtension )
import System.Directory
         ( doesFileExist, doesDirectoryExist, getDirectoryContents
         , removeFile, getHomeDirectory )

import Data.Char ( toLower )
import Data.List ( nub )
import Data.Maybe    ( catMaybes )
import Data.Monoid   ( Monoid(..) )
import Control.Monad ( when, unless )
import Distribution.Compat.Exception

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

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

  (_nhcProg, nhcVersion, conf') <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity nhcProgram :: ProgramnhcProgram
      (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [1,20] [] :: [a][]))
      (userMaybeSpecifyPath ::
  String -> Maybe FilePath -> ProgramDb -> ProgramDbuserMaybeSpecifyPath "nhc98" hcPath :: Maybe FilePathhcPath conf :: ProgramConfigurationconf)

  (_hmakeProg, _hmakeVersion, conf'') <-
    requireProgramVersion ::
  Verbosity
  -> Program
  -> VersionRange
  -> ProgramDb
  -> IO (ConfiguredProgram, Version, ProgramDb)requireProgramVersion verbosity :: Verbosityverbosity hmakeProgram :: ProgramhmakeProgram
     (orLaterVersion :: Version -> VersionRangeorLaterVersion (Version :: [Int] -> [String] -> VersionVersion [3,13] [] :: [a][])) conf' :: ProgramDbconf'
  (_ldProg, conf''')   <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity ldProgram :: ProgramldProgram conf'' :: ProgramDbconf''
  (_arProg, conf'''')  <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity arProgram :: ProgramarProgram conf''' :: ProgramDbconf'''

  --TODO: put this stuff in a monad so we can say just:
  -- requireProgram hmakeProgram (orLaterVersion (Version [3,13] []))
  -- requireProgram ldProgram anyVersion
  -- requireProgram ldPrograrProgramam anyVersion
  -- unless (null (cSources bi)) $ requireProgram ccProgram anyVersion

  let comp = Compiler {
        compilerId         = CompilerId :: CompilerFlavor -> Version -> CompilerIdCompilerId NHC :: CompilerFlavorNHC nhcVersion :: VersionnhcVersion,
        compilerLanguages  = nhcLanguages :: [(Language, Flag)]nhcLanguages,
        compilerExtensions     = nhcLanguageExtensions :: [(Extension, Flag)]nhcLanguageExtensions
      }
  return :: Monad m => forall a. a -> m areturn (comp :: Compilercomp, conf'''' :: ProgramDbconf'''')

nhcLanguages :: [(Language, Flag)]
nhcLanguages = [(Haskell98 :: LanguageHaskell98, "-98")]

-- | The flags for the supported extensions
nhcLanguageExtensions :: [(Extension, Flag)]
nhcLanguageExtensions =
    -- TODO: pattern guards in 1.20
     -- NHC doesn't enforce the monomorphism restriction at all.
     -- Technically it therefore doesn't support MonomorphismRestriction,
     -- but that would mean it doesn't support Haskell98, so we pretend
     -- that it does.
    [(EnableExtension :: KnownExtension -> ExtensionEnableExtension  MonomorphismRestriction :: KnownExtensionMonomorphismRestriction,   "")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension MonomorphismRestriction :: KnownExtensionMonomorphismRestriction,   "")
     -- Similarly, I assume the FFI is always on
    ,(EnableExtension :: KnownExtension -> ExtensionEnableExtension  ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface,  "")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension ForeignFunctionInterface :: KnownExtensionForeignFunctionInterface,  "")
     -- Similarly, I assume existential quantification is always on
    ,(EnableExtension :: KnownExtension -> ExtensionEnableExtension  ExistentialQuantification :: KnownExtensionExistentialQuantification, "")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension ExistentialQuantification :: KnownExtensionExistentialQuantification, "")
     -- Similarly, I assume empty data decls is always on
    ,(EnableExtension :: KnownExtension -> ExtensionEnableExtension  EmptyDataDecls :: KnownExtensionEmptyDataDecls,            "")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension EmptyDataDecls :: KnownExtensionEmptyDataDecls,            "")
    ,(EnableExtension :: KnownExtension -> ExtensionEnableExtension  NamedFieldPuns :: KnownExtensionNamedFieldPuns,            "-puns")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension NamedFieldPuns :: KnownExtensionNamedFieldPuns,            "-nopuns")
     -- CPP can't actually be turned off, but we pretend that it can
    ,(EnableExtension :: KnownExtension -> ExtensionEnableExtension  CPP :: KnownExtensionCPP,                       "-cpp")
    ,(DisableExtension :: KnownExtension -> ExtensionDisableExtension CPP :: KnownExtensionCPP,                       "")
    ]

getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
                     -> IO PackageIndex
getInstalledPackages verbosity packagedbs conf = do
  homedir      <- getHomeDirectory :: IO FilePathgetHomeDirectory
  (nhcProg, _) <- requireProgram ::
  Verbosity
  -> Program
  -> ProgramDb
  -> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity nhcProgram :: ProgramnhcProgram conf :: ProgramConfigurationconf
  let bindir = takeDirectory :: FilePath -> FilePathtakeDirectory (programPath :: ConfiguredProgram -> FilePathprogramPath nhcProg :: ConfiguredProgramnhcProg)
      incdir = takeDirectory :: FilePath -> FilePathtakeDirectory bindir :: FilePathbindir (</>) :: FilePath -> FilePath -> FilePath</> "include" (</>) :: FilePath -> FilePath -> FilePath</> "nhc98"
      dbdirs = nub :: Eq a => [a] -> [a]nub (concatMap :: (a -> [b]) -> [a] -> [b]concatMap (packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]packageDbPaths homedir :: FilePathhomedir incdir :: FilePathincdir) packagedbs :: PackageDBStackpackagedbs)
  indexes  <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM getIndividualDBPackages :: FilePath -> IO PackageIndexgetIndividualDBPackages dbdirs :: [FilePath]dbdirs
  return :: Monad m => forall a. a -> m areturn ($!) :: (a -> b) -> a -> b$! mconcat :: Monoid a => [a] -> amconcat indexes :: [PackageIndex]indexes

  where
    getIndividualDBPackages :: FilePath -> IO PackageIndex
    getIndividualDBPackages dbdir = do
      pkgdirs <- getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)]getPackageDbDirs dbdir :: FilePathdbdir
      pkgs    <- sequence :: Monad m => [m a] -> m [a]sequence [ getInstalledPackage ::
  PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)getInstalledPackage pkgname :: PackageNamepkgname pkgdir :: FilePathpkgdir
                          | (pkgname, pkgdir) <- pkgdirs :: [(PackageName, FilePath)]pkgdirs ]
      let pkgs' = map :: (a -> b) -> [a] -> [b]map setInstalledPackageId ::
  InstalledPackageInfo -> InstalledPackageInfosetInstalledPackageId (catMaybes :: [Maybe a] -> [a]catMaybes pkgs :: [Maybe InstalledPackageInfo]pkgs)
      return :: Monad m => forall a. a -> m areturn (fromList :: [InstalledPackageInfo] -> PackageIndexPackageIndex.fromList pkgs' :: [InstalledPackageInfo]pkgs')

packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]
packageDbPaths _home incdir db = case db :: PackageDBdb of
  GlobalPackageDB        -> [ incdir :: FilePathincdir (</>) :: FilePath -> FilePath -> FilePath</> "packages" ]
  UserPackageDB          -> [] :: [a][] --TODO any standard per-user db?
  SpecificPackageDB path -> [ path :: FilePathpath ]

getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)]
getPackageDbDirs dbdir = do
  dbexists <- doesDirectoryExist :: FilePath -> IO BooldoesDirectoryExist dbdir :: FilePathdbdir
  if not :: Bool -> Boolnot dbexists :: Booldbexists
    then return :: Monad m => forall a. a -> m areturn [] :: [a][]
    else do
      entries  <- getDirectoryContents :: FilePath -> IO [FilePath]getDirectoryContents dbdir :: FilePathdbdir
      pkgdirs  <- sequence :: Monad m => [m a] -> m [a]sequence
        [ do pkgdirExists <- doesDirectoryExist :: FilePath -> IO BooldoesDirectoryExist pkgdir :: FilePathpkgdir
             return :: Monad m => forall a. a -> m areturn (pkgname :: PackageNamepkgname, pkgdir :: FilePathpkgdir, pkgdirExists :: BoolpkgdirExists)
        | (entry, Just pkgname) <- [ (entry :: FilePathentry, simpleParse :: Text a => String -> Maybe asimpleParse entry :: FilePathentry)
                                   | entry <- entries :: [FilePath]entries ]
        , let pkgdir = dbdir :: FilePathdbdir (</>) :: FilePath -> FilePath -> FilePath</> entry :: FilePathentry ]
      return :: Monad m => forall a. a -> m areturn [ (pkgname :: PackageNamepkgname, pkgdir :: FilePathpkgdir) | (pkgname, pkgdir, True) <- pkgdirs :: [(PackageName, FilePath)]pkgdirs ]

getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)
getInstalledPackage pkgname pkgdir = do
  let pkgconfFile = pkgdir :: FilePathpkgdir (</>) :: FilePath -> FilePath -> FilePath</> "package.conf"
  pkgconfExists <- doesFileExist :: FilePath -> IO BooldoesFileExist pkgconfFile :: FilePathpkgconfFile

  let cabalFile = pkgdir :: FilePathpkgdir (<.>) :: FilePath -> String -> FilePath<.> "cabal"
  cabalExists <- doesFileExist :: FilePath -> IO BooldoesFileExist cabalFile :: FilePathcabalFile

  case () of
    _ | pkgconfExists :: BoolpkgconfExists -> getFullInstalledPackageInfo ::
  PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)getFullInstalledPackageInfo pkgname :: PackageNamepkgname pkgconfFile :: FilePathpkgconfFile
      | cabalExists :: BoolcabalExists   -> getPhonyInstalledPackageInfo ::
  PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)getPhonyInstalledPackageInfo pkgname :: PackageNamepkgname cabalFile :: FilePathcabalFile
      | otherwise :: Boolotherwise     -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing

getFullInstalledPackageInfo :: PackageName -> FilePath
                            -> IO (Maybe InstalledPackageInfo)
getFullInstalledPackageInfo pkgname pkgconfFile =
  withUTF8FileContents :: FilePath -> (String -> IO a) -> IO awithUTF8FileContents pkgconfFile :: FilePathpkgconfFile ($) :: (a -> b) -> a -> b$ \contents ->
    case parseInstalledPackageInfo ::
  String -> ParseResult InstalledPackageInfoparseInstalledPackageInfo contents :: Stringcontents of
      ParseOk _ pkginfo | packageName :: Package pkg => pkg -> PackageNamepackageName pkginfo :: InstalledPackageInfopkginfo (==) :: Eq a => a -> a -> Bool== pkgname :: PackageNamepkgname
                        -> return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust pkginfo :: InstalledPackageInfopkginfo)
      _                 -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing

-- | This is a backup option for existing versions of nhc98 which do not supply
-- proper installed package info files for the bundled libs. Instead we look
-- for the .cabal file and extract the package version from that.
-- We don't know any other details for such packages, in particular we pretend
-- that they have no dependencies.
--
getPhonyInstalledPackageInfo :: PackageName -> FilePath
                             -> IO (Maybe InstalledPackageInfo)
getPhonyInstalledPackageInfo pkgname pathsModule = do
  content <- readFile :: FilePath -> IO StringreadFile pathsModule :: FilePathpathsModule
  case extractVersion :: String -> Maybe VersionextractVersion content :: Stringcontent of
    Nothing      -> return :: Monad m => forall a. a -> m areturn Nothing :: Maybe aNothing
    Just version -> return :: Monad m => forall a. a -> m areturn (Just :: a -> Maybe aJust pkginfo :: InstalledPackageInfopkginfo)
      where
        pkgid   = PackageIdentifier :: PackageName -> Version -> PackageIdentifierPackageIdentifier pkgname :: PackageNamepkgname version :: Versionversion
        pkginfo = emptyInstalledPackageInfo :: InstalledPackageInfo_ memptyInstalledPackageInfo { sourcePackageId = pkgid :: PackageIdentifierpkgid }
  where
    -- search through the .cabal file, looking for a line like:
    --
    -- > version: 2.0
    --
    extractVersion :: String -> Maybe Version
    extractVersion content =
      case catMaybes :: [Maybe a] -> [a]catMaybes (map :: (a -> b) -> [a] -> [b]map extractVersionLine :: String -> Maybe VersionextractVersionLine (lines :: String -> [String]lines content :: Stringcontent)) of
        [version] -> Just :: a -> Maybe aJust version :: Versionversion
        _         -> Nothing :: Maybe aNothing
    extractVersionLine :: String -> Maybe Version
    extractVersionLine line =
      case words :: String -> [String]words line :: Stringline of
        [versionTag, ":", versionStr]
          | map :: (a -> b) -> [a] -> [b]map toLower :: Char -> ChartoLower versionTag :: StringversionTag (==) :: Eq a => a -> a -> Bool== "version"  -> simpleParse :: Text a => String -> Maybe asimpleParse versionStr :: StringversionStr
        [versionTag,      versionStr]
          | map :: (a -> b) -> [a] -> [b]map toLower :: Char -> ChartoLower versionTag :: StringversionTag (==) :: Eq a => a -> a -> Bool== "version:" -> simpleParse :: Text a => String -> Maybe asimpleParse versionStr :: StringversionStr
        _                                        -> Nothing :: Maybe aNothing

-- Older installed package info files did not have the installedPackageId
-- field, so if it is missing then we fill it as the source package ID.
setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo
setInstalledPackageId pkginfo@InstalledPackageInfo {
                        installedPackageId = InstalledPackageId "",
                        sourcePackageId    = pkgid
                      }
                    = pkginfo :: InstalledPackageInfopkginfo {
                        --TODO use a proper named function for the conversion
                        -- from source package id to installed package id
                        installedPackageId = InstalledPackageId :: String -> InstalledPackageIdInstalledPackageId (display :: Text a => a -> Stringdisplay pkgid :: PackageIdentifierpkgid)
                      }
setInstalledPackageId pkginfo = pkginfo :: InstalledPackageInfopkginfo

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

-- |FIX: For now, the target must contain a main module.  Not used
-- ATM. Re-add later.
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Library            -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
  let conf = withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi
      Just nhcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram nhcProgram :: ProgramnhcProgram conf :: ProgramConfigurationconf
  let bi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
      modules = exposedModules :: Library -> [ModuleName]exposedModules lib :: Librarylib (++) :: [a] -> [a] -> [a]++ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi
      -- Unsupported extensions have already been checked by configure
      languageFlags = 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)
  inFiles <- getModulePaths ::
  LocalBuildInfo -> BuildInfo -> [ModuleName] -> IO [FilePath]getModulePaths lbi :: LocalBuildInfolbi bi :: BuildInfobi modules :: [ModuleName]modules
  let targetDir = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi
      srcDirs  = nub :: Eq a => [a] -> [a]nub (map :: (a -> b) -> [a] -> [b]map takeDirectory :: FilePath -> FilePathtakeDirectory inFiles :: [FilePath]inFiles)
      destDirs = map :: (a -> b) -> [a] -> [b]map (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</>) srcDirs :: [FilePath]srcDirs
  mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue) destDirs :: [FilePath]destDirs
  rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity hmakeProgram :: ProgramhmakeProgram conf :: ProgramConfigurationconf ($) :: (a -> b) -> a -> b$
       ["-hc=" (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath nhcProg :: ConfiguredProgramnhcProg]
    (++) :: [a] -> [a] -> [a]++ nhcVerbosityOptions :: Verbosity -> [String]nhcVerbosityOptions verbosity :: Verbosityverbosity
    (++) :: [a] -> [a] -> [a]++ ["-d", targetDir :: FilePathtargetDir, "-hidir", targetDir :: FilePathtargetDir]
    (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions NHC :: CompilerFlavorNHC (.) :: (b -> c) -> (a -> b) -> a -> c. libBuildInfo :: Library -> BuildInfolibBuildInfo)
                           (library :: PackageDescription -> Maybe Librarylibrary pkg_descr :: PackageDescriptionpkg_descr)
    (++) :: [a] -> [a] -> [a]++ languageFlags :: [Flag]languageFlags
    (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [ ["-package", display :: Text a => a -> Stringdisplay (packageName :: Package pkg => pkg -> PackageNamepackageName pkgid :: PackageIdentifierpkgid) ]
              | (_, pkgid) <- componentPackageDeps ::
  ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
    (++) :: [a] -> [a] -> [a]++ inFiles :: [FilePath]inFiles
{-
  -- build any C sources
  unless (null (cSources bi)) $ do
     info verbosity "Building C Sources..."
     let commonCcArgs = (if verbosity >= deafening then ["-v"] else [])
                     ++ ["-I" ++ dir | dir <- includeDirs bi]
                     ++ [opt | opt <- ccOptions bi]
                     ++ (if withOptimization lbi then ["-O2"] else [])
     flip mapM_ (cSources bi) $ \cfile -> do
       let ofile = targetDir </> cfile `replaceExtension` objExtension
       createDirectoryIfMissingVerbose verbosity True (takeDirectory ofile)
       rawSystemProgramConf verbosity hmakeProgram conf
         (commonCcArgs ++ ["-c", cfile, "-o", ofile])
-}
  -- link:
  info :: Verbosity -> String -> IO ()info verbosity :: Verbosityverbosity "Linking..."
  let --cObjs = [ targetDir </> cFile `replaceExtension` objExtension
      --        | cFile <- cSources bi ]
      libFilePath = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> mkLibName :: PackageIdentifier -> StringmkLibName (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg_descr :: PackageDescriptionpkg_descr)
      hObjs = [ targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> toFilePath :: ModuleName -> FilePathModuleName.toFilePath m :: ModuleNamem (<.>) :: FilePath -> String -> FilePath<.> objExtension :: StringobjExtension
              | m <- modules :: [ModuleName]modules ]

  unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull hObjs :: [FilePath]hObjs {-&& null cObjs-}) ($) :: (a -> b) -> a -> b$ do
    -- first remove library if it exists
    removeFile :: FilePath -> IO ()removeFile libFilePath :: FilePathlibFilePath catchIO :: IO a -> (IOException -> IO a) -> IO a`catchIO` \_ -> return :: Monad m => forall a. a -> m areturn ()

    let arVerbosity | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= deafening :: Verbositydeafening = "v"
                    | verbosity :: Verbosityverbosity (>=) :: Ord a => a -> a -> Bool>= normal :: Verbositynormal = ""
                    | otherwise :: Boolotherwise = "c"

    rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity arProgram :: ProgramarProgram (withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi) ($) :: (a -> b) -> a -> b$
         ["q"(++) :: [a] -> [a] -> [a]++ arVerbosity :: [Char]arVerbosity, libFilePath :: FilePathlibFilePath]
      (++) :: [a] -> [a] -> [a]++ hObjs :: [FilePath]hObjs
--    ++ cObjs

-- | Building an executable for NHC.
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
                      -> Executable         -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity pkg_descr lbi exe clbi = do
  let conf = withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms lbi :: LocalBuildInfolbi
      Just nhcProg = lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgramlookupProgram nhcProgram :: ProgramnhcProgram conf :: ProgramConfigurationconf
  when :: Monad m => Bool -> m () -> m ()when (dropExtension :: FilePath -> FilePathdropExtension (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe) (/=) :: Eq a => a -> a -> Bool/= exeName :: Executable -> StringexeName exe :: Executableexe) ($) :: (a -> b) -> a -> b$
    die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "hmake does not support exe names that do not match the name of "
       (++) :: [a] -> [a] -> [a]++ "the 'main-is' file. You will have to rename your executable to "
       (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow (dropExtension :: FilePath -> FilePathdropExtension (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe))
  let bi = buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe
      modules = otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi
      -- Unsupported extensions have already been checked by configure
      languageFlags = 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)
  inFiles <- getModulePaths ::
  LocalBuildInfo -> BuildInfo -> [ModuleName] -> IO [FilePath]getModulePaths lbi :: LocalBuildInfolbi bi :: BuildInfobi modules :: [ModuleName]modules
  let targetDir = buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (</>) :: FilePath -> FilePath -> FilePath</> exeName :: Executable -> StringexeName exe :: Executableexe
      exeDir    = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> (exeName :: Executable -> StringexeName exe :: Executableexe (++) :: [a] -> [a] -> [a]++ "-tmp")
      srcDirs   = nub :: Eq a => [a] -> [a]nub (map :: (a -> b) -> [a] -> [b]map takeDirectory :: FilePath -> FilePathtakeDirectory (modulePath :: Executable -> FilePathmodulePath exe :: Executableexe (:) :: a -> [a] -> [a]: inFiles :: [FilePath]inFiles))
      destDirs  = map :: (a -> b) -> [a] -> [b]map (exeDir :: FilePathexeDir (</>) :: FilePath -> FilePath -> FilePath</>) srcDirs :: [FilePath]srcDirs
  mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue) destDirs :: [FilePath]destDirs
  rawSystemProgramConf ::
  Verbosity -> Program -> ProgramConfiguration -> [ProgArg] -> IO ()rawSystemProgramConf verbosity :: Verbosityverbosity hmakeProgram :: ProgramhmakeProgram conf :: ProgramConfigurationconf ($) :: (a -> b) -> a -> b$
       ["-hc=" (++) :: [a] -> [a] -> [a]++ programPath :: ConfiguredProgram -> FilePathprogramPath nhcProg :: ConfiguredProgramnhcProg]
    (++) :: [a] -> [a] -> [a]++ nhcVerbosityOptions :: Verbosity -> [String]nhcVerbosityOptions verbosity :: Verbosityverbosity
    (++) :: [a] -> [a] -> [a]++ ["-d", targetDir :: FilePathtargetDir, "-hidir", targetDir :: FilePathtargetDir]
    (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] (hcOptions :: CompilerFlavor -> BuildInfo -> [String]hcOptions NHC :: CompilerFlavorNHC (.) :: (b -> c) -> (a -> b) -> a -> c. libBuildInfo :: Library -> BuildInfolibBuildInfo)
                           (library :: PackageDescription -> Maybe Librarylibrary pkg_descr :: PackageDescriptionpkg_descr)
    (++) :: [a] -> [a] -> [a]++ languageFlags :: [Flag]languageFlags
    (++) :: [a] -> [a] -> [a]++ concat :: [[a]] -> [a]concat [ ["-package", display :: Text a => a -> Stringdisplay (packageName :: Package pkg => pkg -> PackageNamepackageName pkgid :: PackageIdentifierpkgid) ]
              | (_, pkgid) <- componentPackageDeps ::
  ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]componentPackageDeps clbi :: ComponentLocalBuildInfoclbi ]
    (++) :: [a] -> [a] -> [a]++ inFiles :: [FilePath]inFiles
    (++) :: [a] -> [a] -> [a]++ [exeName :: Executable -> StringexeName exe :: Executableexe]

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

--TODO: where to put this? it's duplicated in .Simple too
getModulePaths :: LocalBuildInfo -> BuildInfo -> [ModuleName] -> IO [FilePath]
getModulePaths lbi bi modules = sequence :: Monad m => [m a] -> m [a]sequence
   [ findFileWithExtension ::
  [String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension ["hs", "lhs"] (buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi (:) :: a -> [a] -> [a]: hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)
       (toFilePath :: ModuleName -> FilePathModuleName.toFilePath module_ :: amodule_) (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= maybe :: b -> (a -> b) -> Maybe a -> bmaybe (notFound :: a -> IO anotFound module_ :: amodule_) (return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. normalise :: FilePath -> FilePathnormalise)
   | module_ <- modules :: [ModuleName]modules ]
   where notFound module_ = die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "can't find source for module " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay module_ :: amodule_

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

-- |Install executables for NHC.
installExe :: Verbosity -- ^verbosity
           -> FilePath  -- ^install location
           -> FilePath  -- ^Build location
           -> (FilePath, FilePath)  -- ^Executable (prefix,suffix)
           -> Executable
           -> IO ()
installExe verbosity pref buildPref (progprefix,progsuffix) exe
    = do createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue pref :: FilePathpref
         let exeBaseName = exeName :: Executable -> StringexeName exe :: Executableexe
             exeFileName = exeBaseName :: StringexeBaseName (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
             fixedExeFileName = (progprefix :: FilePathprogprefix (++) :: [a] -> [a] -> [a]++ exeBaseName :: StringexeBaseName (++) :: [a] -> [a] -> [a]++ progsuffix :: FilePathprogsuffix) (<.>) :: FilePath -> String -> FilePath<.> exeExtension :: StringexeExtension
         installExecutableFile :: Verbosity -> FilePath -> FilePath -> IO ()installExecutableFile verbosity :: Verbosityverbosity
           (buildPref :: FilePathbuildPref (</>) :: FilePath -> FilePath -> FilePath</> exeBaseName :: StringexeBaseName (</>) :: FilePath -> FilePath -> FilePath</> exeFileName :: FilePathexeFileName)
           (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> fixedExeFileName :: FilePathfixedExeFileName)

-- |Install for nhc98: .hi and .a files
installLib    :: Verbosity -- ^verbosity
              -> FilePath  -- ^install location
              -> FilePath  -- ^Build location
              -> PackageIdentifier
              -> Library
              -> IO ()
installLib verbosity pref buildPref pkgid lib
    = do let bi = libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib
             modules = exposedModules :: Library -> [ModuleName]exposedModules lib :: Librarylib (++) :: [a] -> [a] -> [a]++ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi
         findModuleFiles ::
  [FilePath] -> [String] -> [ModuleName] -> IO [(FilePath, FilePath)]findModuleFiles [buildPref :: FilePathbuildPref] ["hi"] modules :: [ModuleName]modules
           (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= installOrdinaryFiles ::
  Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()installOrdinaryFiles verbosity :: Verbosityverbosity pref :: FilePathpref
         let libName = mkLibName :: PackageIdentifier -> StringmkLibName pkgid :: PackageIdentifierpkgid
         installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity (buildPref :: FilePathbuildPref (</>) :: FilePath -> FilePath -> FilePath</> libName :: StringlibName) (pref :: FilePathpref (</>) :: FilePath -> FilePath -> FilePath</> libName :: StringlibName)