Install.hs 7.84 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
Don Stewart's avatar
Don Stewart committed
3
-- Module      :  Hackage.Install
4
5
6
7
8
9
10
11
12
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- High level interface to package installation.
-----------------------------------------------------------------------------
Don Stewart's avatar
Don Stewart committed
13
module Hackage.Install
14
    ( install
15
16
    ) where

17
import Control.Exception (bracket_, try)
18
import Control.Monad (when)
Duncan Coutts's avatar
Duncan Coutts committed
19
import Data.Monoid (Monoid(mempty))
bjorn@bringert.net's avatar
bjorn@bringert.net committed
20
import System.Directory (getTemporaryDirectory, createDirectoryIfMissing
21
22
                        ,removeDirectoryRecursive, doesFileExist)
import System.FilePath ((</>),(<.>))
bjorn@bringert.net's avatar
bjorn@bringert.net committed
23

24
import Hackage.Dependency (resolveDependencies, resolveDependenciesLocal, packagesToInstall)
25
import Hackage.Fetch (fetchPackage)
Don Stewart's avatar
Don Stewart committed
26
27
import Hackage.Tar (extractTarGzFile)
import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..)
Duncan Coutts's avatar
Duncan Coutts committed
28
                     , PkgInfo(..), FlagAssignment)
29
import Hackage.Utils
30

Duncan Coutts's avatar
Duncan Coutts committed
31
32
33
import Distribution.Simple.Compiler (Compiler, PackageDB(..))
import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration)
import Distribution.Simple.Command (commandShowOptions)
34
import Distribution.Simple.SetupWrapper (setupWrapper)
Duncan Coutts's avatar
Duncan Coutts committed
35
36
import Distribution.Simple.Setup (toFlag)
import qualified Distribution.Simple.Setup as Cabal
37
import Distribution.Simple.Utils (defaultPackageDesc)
38
import Distribution.Package (showPackageId, PackageIdentifier(..))
Duncan Coutts's avatar
Duncan Coutts committed
39
import Distribution.PackageDescription (readPackageDescription)
40
import Distribution.Simple.Utils as Utils (notice, info, debug, die)
bjorn@bringert.net's avatar
bjorn@bringert.net committed
41

42
43

-- |Installs the packages needed to satisfy a list of dependencies.
Duncan Coutts's avatar
Duncan Coutts committed
44
45
46
47
install :: ConfigFlags -> Compiler -> ProgramConfiguration -> Cabal.ConfigFlags -> [UnresolvedDependency] -> IO ()
install cfg comp conf configFlags deps
    | null deps = installLocalPackage cfg comp conf configFlags
    | otherwise = installRepoPackages cfg comp conf configFlags deps
48
49

-- | Install the unpacked package in the current directory, and all its dependencies.
Duncan Coutts's avatar
Duncan Coutts committed
50
51
installLocalPackage :: ConfigFlags -> Compiler -> ProgramConfiguration -> Cabal.ConfigFlags -> IO ()
installLocalPackage cfg comp conf configFlags =
52
53
   do cabalFile <- defaultPackageDesc (configVerbose cfg)
      desc <- readPackageDescription (configVerbose cfg) cabalFile
Duncan Coutts's avatar
Duncan Coutts committed
54
55
      resolvedDeps <- resolveDependenciesLocal cfg comp conf desc
                        (Cabal.configConfigurationsFlags configFlags)
56
      case packagesToInstall resolvedDeps of
57
        Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
Duncan Coutts's avatar
Duncan Coutts committed
58
59
        Right pkgs   -> installPackages cfg configFlags pkgs
      installUnpackedPkg cfg configFlags Nothing
60

Duncan Coutts's avatar
Duncan Coutts committed
61
62
installRepoPackages :: ConfigFlags -> Compiler -> ProgramConfiguration -> Cabal.ConfigFlags -> [UnresolvedDependency] -> IO ()
installRepoPackages cfg comp conf configFlags deps =
63
64
    do resolvedDeps <- resolveDependencies cfg comp conf deps
       case packagesToInstall resolvedDeps of
65
66
         Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
         Right []     -> notice verbosity "All requested packages already installed. Nothing to do."
Duncan Coutts's avatar
Duncan Coutts committed
67
         Right pkgs   -> installPackages cfg configFlags pkgs
68
  where verbosity = configVerbose cfg
69
70

installPackages :: ConfigFlags
Duncan Coutts's avatar
Duncan Coutts committed
71
72
                -> Cabal.ConfigFlags -- ^Options which will be passed to every package.
                -> [(PkgInfo,FlagAssignment)] -- ^ (Package, list of configure options)
73
                -> IO ()
74
75
76
77
78
79
80
81
82
83
84
85
86
87
installPackages cfg configFlags pkgs = do 
  errorPackages <- installPackagesErrs pkgs []
  case errorPackages of
    [] -> return ()
    pkgs -> do let errorMsg = concat $ "Error: some packages failed to install:"
                             : ["\n  " ++ showPackageId (pkgInfoId x) | (x, _) <- pkgs]
               die errorMsg

  where installPackagesErrs (pkg:pkgs) errPkgs = do
          maybeInstalled <- try (installPkg cfg configFlags pkg)
          case maybeInstalled of
            Left e ->  installPackagesErrs pkgs (pkg:errPkgs)
            Right _ -> installPackagesErrs pkgs errPkgs
        installPackagesErrs [] ers = return ers
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\'
101
102
      if the 'configUser' flag is @True@ and install directory flags depending on 
      @configUserInstallDirs@ or @configGlobalInstallDirs@.
103
104
105

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

106
    * setupWrapper \'install\' is called with the \'--user\' flag if 'configUserInstall' is @True@.
107
108
109
110

    * The installation finishes by deleting the unpacked tarball.
-} 
installPkg :: ConfigFlags
Duncan Coutts's avatar
Duncan Coutts committed
111
112
           -> Cabal.ConfigFlags -- ^Options which will be parse to every package.
           -> (PkgInfo,FlagAssignment) -- ^(Package, list of configure options)
113
           -> IO ()
Duncan Coutts's avatar
Duncan Coutts committed
114
installPkg cfg configFlags (pkg,flags)
115
    = do pkgPath <- fetchPackage cfg pkg
116
         tmp <- getTemporaryDirectory
117
         let p = pkgInfoId pkg
118
             tmpDirPath = tmp </> ("TMP" ++ showPackageId p)
119
             path = tmpDirPath </> showPackageId p
120
121
         bracket_ (createDirectoryIfMissing True tmpDirPath)
                  (removeDirectoryRecursive tmpDirPath)
122
                  (do info verbosity $ "Extracting " ++ pkgPath ++ " to " ++ tmpDirPath ++ "..."
123
                      extractTarGzFile (Just tmpDirPath) pkgPath
124
                      let descFilePath = tmpDirPath </> showPackageId p </> pkgName p <.> "cabal"
125
                      e <- doesFileExist descFilePath
126
                      when (not e) $ die $ "Package .cabal file not found: " ++ show descFilePath
Duncan Coutts's avatar
Duncan Coutts committed
127
128
129
130
                      let configFlags' = configFlags {
                            Cabal.configConfigurationsFlags =
                              Cabal.configConfigurationsFlags configFlags ++ flags }
                      installUnpackedPkg cfg configFlags' (Just path))
131
  where verbosity = configVerbose cfg
132

Duncan Coutts's avatar
Duncan Coutts committed
133
134
installUnpackedPkg :: ConfigFlags
                   -> Cabal.ConfigFlags -- ^ Arguments for this package
135
136
                   -> Maybe FilePath -- ^ Directory to change to before starting the installation.
                   -> IO ()
Duncan Coutts's avatar
Duncan Coutts committed
137
138
139
140
installUnpackedPkg cfg configFlags mpath
    = do setup ("configure" : configureOptions)
         setup ["build"]
         setup ["install"]
141
  where
Duncan Coutts's avatar
Duncan Coutts committed
142
143
    configureOptions = mkPkgOps cfg configFlags
    setup cmds
144
        = do debug (configVerbose cfg) $
Duncan Coutts's avatar
Duncan Coutts committed
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
               "setupWrapper in " ++ show mpath ++ " :\n " ++ show cmds
             setupWrapper cmds mpath

-- Attach the correct prefix flag to configure commands,
-- correct --user flag to install commands and no options to other commands.
mkPkgOps :: ConfigFlags -> Cabal.ConfigFlags -> [String]
mkPkgOps cfg configFlags =
  commandShowOptions (Cabal.configureCommand defaultProgramConfiguration) configFlags {
    Cabal.configHcFlavor  = toFlag (configCompiler cfg),
    Cabal.configHcPath    = maybe (Cabal.configHcPath configFlags)
                                  toFlag (configCompilerPath cfg),
    Cabal.configHcPkg     = maybe (Cabal.configHcPkg configFlags)
                                  toFlag (configHcPkgPath cfg),
    Cabal.configInstallDirs = fmap (maybe mempty toFlag) installDirTemplates,
    Cabal.configVerbose   = toFlag (configVerbose cfg),
    Cabal.configPackageDB = if configUserInstall cfg
                              then toFlag UserPackageDB
                              else toFlag GlobalPackageDB
  }
 where installDirTemplates | configUserInstall cfg = configUserInstallDirs cfg
                           | otherwise             = configGlobalInstallDirs cfg