Install.hs 6.17 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
-----------------------------------------------------------------------------
-- |
-- Module      :  Network.Hackage.CabalInstall.Install
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- High level interface to package installation.
-----------------------------------------------------------------------------
module Network.Hackage.CabalInstall.Install
    ( install    -- :: ConfigFlags -> [UnresolvedDependency] -> IO ()
    , installPkg -- :: ConfigFlags -> (PackageIdentifier,[String],String) -> IO ()
    ) where

mnislaih's avatar
mnislaih committed
18
19
import Data.List  (elemIndex)
import Data.Maybe (fromJust)
20
21
22
23
24
25
26
27
28
29
30
31
import Debug.Trace
import Control.Exception (bracket_)

import Network.Hackage.CabalInstall.Dependency (getPackages, resolveDependencies)
import Network.Hackage.CabalInstall.Fetch (isFetched, packageFile, fetchPackage)
import Network.Hackage.CabalInstall.Types (ConfigFlags(..), UnresolvedDependency(..)
                                      ,OutputGen(..))
import Network.Hackage.CabalInstall.TarUtils

import Distribution.SetupWrapper (setupWrapper)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Package (showPackageId, PackageIdentifier)
mnislaih's avatar
mnislaih committed
32
import Distribution.Verbosity
33
import System.FilePath ((</>), splitFileName)
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

import Data.Maybe (fromMaybe, maybeToList)
import Text.Printf (printf, PrintfType)
import System.Directory (getTemporaryDirectory, createDirectoryIfMissing
                        ,removeDirectoryRecursive, copyFile)
import System.IO (hPutStrLn, stderr)
import System.Process (runProcess, waitForProcess, terminateProcess)
import System.Exit (ExitCode(..))
import System.Posix.Signals

-- |Installs the packages needed to satisfy a list of dependencies.
install :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO ()
install cfg globalArgs deps
    = do ipkgs <- getInstalledPackages (configCompiler cfg) (configUserIns cfg) (configVerbose cfg)
         resolvedDeps <- resolveDependencies cfg ipkgs deps
         let apkgs = getPackages resolvedDeps
         if null apkgs
           then putStrLn "All requested packages already installed. Nothing to do."
           else mapM_ (installPkg cfg globalArgs) apkgs

-- Fetch a package and output nice messages.
downloadPkg :: ConfigFlags -> PackageIdentifier -> String -> IO FilePath
downloadPkg cfg pkg location
    = do fetched <- isFetched cfg pkg
         if fetched
            then do pkgIsPresent (configOutputGen cfg) pkg
                    return (packageFile cfg pkg)
61
            else fetchPackage cfg pkg location
62
63
64
65
66
67
68
69
70

-- Attach the correct prefix flag to configure commands,
-- correct --user flag to install commands and no options to other commands.
mkPkgOps :: ConfigFlags -> String -> [String] -> [String]
mkPkgOps cfg cmd ops = verbosity ++
  case cmd of
    "configure" -> user ++ prefix ++ ops
    "install"   -> user
    _ -> []
mnislaih's avatar
mnislaih committed
71
 where verbosity = ["--verbose=" ++ showForCabal (configVerbose cfg)]
72
73
       user = if configUserIns cfg then ["--user"] else []
       prefix = maybeToList (fmap ("--prefix=" ++) (configPrefix cfg))
mnislaih's avatar
mnislaih committed
74
       showForCabal v = show$ fromJust$ elemIndex v [silent,normal,verbose,deafening]
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{-|
  Download, build and install a given package with some given flags.

  The process is divided up in a few steps:

    * The package is downloaded to {config-dir}\/packages\/{pkg-id} (if not already there).

    * The fetched tarball is then moved to a temporary directory (\/tmp on linux) and unpacked.

    * setupWrapper (equivalent to cabal-setup) is called with the options
      \'configure\' and the user specified options, \'--user\'
      if the 'configUser' flag is @True@ and \'--prefix=[PREFIX]\' if 'configPrefix' is not @Nothing@.

    * setupWrapper \'build\' is called with no options.

    * setupWrapper \'install\' is called with the \'--user\' flag if 'configUserIns' is @True@.

    * The installation finishes by deleting the unpacked tarball.
-} 
installPkg :: ConfigFlags
           -> [String] -- ^Options which will be parse to every package.
           -> (PackageIdentifier,[String],String) -- ^(Package, list of configure options, package location)
           -> IO ()
installPkg cfg globalArgs (pkg,ops,location)
    = do pkgPath <- downloadPkg cfg pkg location
         tmp <- getTemporaryDirectory
101
102
         let tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId pkg)
             tmpPkgPath = tmpDirPath </> printf "TAR%s.tgz" (showPackageId pkg)
103
104
             setup cmd
                 = let cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
105
                       path = tmpDirPath </> showPackageId pkg
mnislaih's avatar
mnislaih committed
106
107
                   in do message output deafening $ 
                                 unwords ["setupWrapper", show (cmd:cmdOps), show path]
108
109
110
111
                         setupWrapper (cmd:cmdOps) (Just path)
         bracket_ (createDirectoryIfMissing True tmpDirPath)
                  (removeDirectoryRecursive tmpDirPath)
                  (do copyFile pkgPath tmpPkgPath
mnislaih's avatar
mnislaih committed
112
                      message output deafening (printf "Extracting %s..." tmpPkgPath)
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
                      extractTarFile tarProg tmpPkgPath
                      installUnpackedPkg cfg pkg tmpPkgPath setup
                      return ())
    where runHc = configRunHc cfg
          tarProg = configTarPath cfg
          output = configOutputGen cfg

installUnpackedPkg :: ConfigFlags -> PackageIdentifier -> FilePath
                   -> (String -> IO ()) -> IO ()
installUnpackedPkg cfg pkgId tarFile setup
    = do tarFiles <- tarballGetFiles tarProg tarFile
         let cabalFile = locateFileExt tarFiles "cabal"
         case cabalFile of
           Just f -> let (path,_) = splitFileName f
                     in do buildingPkg output pkgId
                           stepConfigPkg output pkgId
                           setup "configure"
                           stepBuildPkg output pkgId
                           setup "build"
                           stepInstallPkg output pkgId
                           setup "install"
                           stepFinishedPkg output pkgId
                           return ()
           Nothing -> noCabalFile output pkgId
    where output = configOutputGen cfg
          tarProg = configTarPath cfg