Install.hs 9.34 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
3
-- Module      :  Distribution.Simple.Install
4
-- Copyright   :  Isaac Jones 2003-2004
5
--
Duncan Coutts's avatar
Duncan Coutts committed
6
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
7
-- Portability :  portable
8
--
Duncan Coutts's avatar
Duncan Coutts committed
9
10
11
12
-- This is the entry point into installing a built package. Performs the
-- \"@.\/setup install@\" and \"@.\/setup copy@\" actions. It moves files into
-- place based on the prefix argument. It does the generic bits and then calls
-- compiler-specific functions to do the rest.
13

ijones's avatar
ijones committed
14
{- All rights reserved.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

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. -}

simonmar's avatar
simonmar committed
44
module Distribution.Simple.Install (
45
        install,
simonmar's avatar
simonmar committed
46
  ) where
47

simonmar's avatar
simonmar committed
48
import Distribution.PackageDescription (
49
50
        PackageDescription(..), BuildInfo(..), Library(..),
        hasLibs, withLib, hasExes, withExe )
51
import Distribution.Package (Package(..))
52
import Distribution.Simple.LocalBuildInfo (
53
54
        LocalBuildInfo(..), InstallDirs(..), absoluteInstallDirs,
        substPathTemplate)
55
import Distribution.Simple.BuildPaths (haddockName, haddockPref)
56
import Distribution.Simple.Utils
57
         ( createDirectoryIfMissingVerbose, installDirectoryContents
58
         , installOrdinaryFile, die, info, notice, matchDirFileGlob )
59
60
import Distribution.Simple.Compiler
         ( CompilerFlavor(..), compilerFlavor )
61
import Distribution.Simple.Setup (CopyFlags(..), CopyDest(..), fromFlag)
62

63
import qualified Distribution.Simple.GHC  as GHC
64
import qualified Distribution.Simple.NHC  as NHC
65
import qualified Distribution.Simple.JHC  as JHC
David Himmelstrup's avatar
David Himmelstrup committed
66
import qualified Distribution.Simple.LHC  as LHC
67
68
import qualified Distribution.Simple.Hugs as Hugs

69
import Control.Monad (when, unless)
70
71
import System.Directory
         ( doesDirectoryExist, doesFileExist )
72
73
import System.FilePath
         ( takeFileName, takeDirectory, (</>), isAbsolute )
simonmar's avatar
simonmar committed
74

75
76
import Distribution.Verbosity

ijones's avatar
ijones committed
77
78
79
80
81
82
83
-- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\"
-- actions.  Move files into place based on the prefix argument.  FIX:
-- nhc isn't implemented yet.

install :: PackageDescription -- ^information from the .cabal file
        -> LocalBuildInfo -- ^information from the configure step
        -> CopyFlags -- ^flags sent to copy or install
ijones's avatar
ijones committed
84
        -> IO ()
85
install pkg_descr lbi flags = do
86
87
  let distPref  = fromFlag (copyDistPref flags)
      verbosity = fromFlag (copyVerbosity flags)
88
      copydest  = fromFlag (copyDest flags)
89
      installDirs@(InstallDirs {
90
         bindir     = binPref,
91
         libdir     = libPref,
92
--         dynlibdir  = dynlibPref, --see TODO below
93
94
         datadir    = dataPref,
         progdir    = progPref,
95
         docdir     = docPref,
96
         htmldir    = htmlPref,
97
         haddockdir = interfacePref,
98
         includedir = incPref})
99
             = absoluteInstallDirs pkg_descr lbi copydest
100

101
102
103
104
105
      --TODO: decide if we need the user to be able to control the libdir
      -- for shared libs independently of the one for static libs. If so
      -- it should also have a flag in the command line UI
      -- For the moment use dynlibdir = libdir
      dynlibPref = libPref
106
107
      progPrefixPref = substPathTemplate (packageId pkg_descr) lbi (progPrefix lbi)
      progSuffixPref = substPathTemplate (packageId pkg_descr) lbi (progSuffix lbi)
108

109
110
  docExists <- doesDirectoryExist $ haddockPref distPref pkg_descr
  info verbosity ("directory " ++ haddockPref distPref pkg_descr ++
111
                  " does exist: " ++ show docExists)
112
113
114

  installDataFiles verbosity pkg_descr dataPref

115
  when docExists $ do
116
      createDirectoryIfMissingVerbose verbosity True htmlPref
117
      installDirectoryContents verbosity
118
          (haddockPref distPref pkg_descr) htmlPref
119
      -- setPermissionsRecursive [Read] htmlPref
120
121
122
123
      -- The haddock interface file actually already got installed
      -- in the recursive copy, but now we install it where we actually
      -- want it to be (normally the same place). We could remove the
      -- copy in htmlPref first.
124
125
126
127
128
129
130
131
      let haddockInterfaceFileSrc  = haddockPref distPref pkg_descr
                                                   </> haddockName pkg_descr
          haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr
      -- We only generate the haddock interface file for libs, So if the
      -- package consists only of executables there will not be one:
      exists <- doesFileExist haddockInterfaceFileSrc
      when exists $ do
        createDirectoryIfMissingVerbose verbosity True interfacePref
132
133
        installOrdinaryFile verbosity haddockInterfaceFileSrc
                                      haddockInterfaceFileDest
Duncan Coutts's avatar
Duncan Coutts committed
134
135
136

  let lfile = licenseFile pkg_descr
  unless (null lfile) $ do
137
    createDirectoryIfMissingVerbose verbosity True docPref
138
    installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile)
Duncan Coutts's avatar
Duncan Coutts committed
139

ijones's avatar
ijones committed
140
  let buildPref = buildDir lbi
141
  when (hasLibs pkg_descr) $
142
    notice verbosity ("Installing library in " ++ libPref)
143
  when (hasExes pkg_descr) $
144
    notice verbosity ("Installing executable(s) in " ++ binPref)
145
146
147

  -- install include files for all compilers - they may be needed to compile
  -- haskell files (using the CPP extension)
148
  when (hasLibs pkg_descr) $ installIncludeFiles verbosity pkg_descr incPref
149

150
  case compilerFlavor (compiler lbi) of
151
     GHC  -> do withLib pkg_descr $ \_ ->
152
                  GHC.installLib flags lbi libPref dynlibPref buildPref pkg_descr
153
                withExe pkg_descr $ \_ ->
154
                  GHC.installExe flags lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
155
     LHC  -> do withLib pkg_descr $ \_ ->
156
157
                  LHC.installLib flags lbi libPref dynlibPref buildPref pkg_descr
                withExe pkg_descr $ \_ ->
158
                  LHC.installExe flags lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr
159
     JHC  -> do withLib pkg_descr $ JHC.installLib verbosity libPref buildPref pkg_descr
160
                withExe pkg_descr $ JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr
161
     Hugs -> do
162
       let targetProgPref = progdir (absoluteInstallDirs pkg_descr lbi NoCopyDest)
163
       let scratchPref = scratchDir lbi
164
       Hugs.install verbosity libPref progPref binPref targetProgPref scratchPref (progPrefixPref, progSuffixPref) pkg_descr
165
     NHC  -> do withLib pkg_descr $ NHC.installLib verbosity libPref buildPref (packageId pkg_descr)
166
                withExe pkg_descr $ NHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref)
167
     _    -> die ("only installing with GHC, JHC, Hugs or nhc98 is implemented")
168
169
  return ()
  -- register step should be performed by caller.
simonmar's avatar
simonmar committed
170

171
172
173
174
175
176
177
178
179
-- | Install the files listed in data-files
--
installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
installDataFiles verbosity pkg_descr destDataDir =
  flip mapM_ (dataFiles pkg_descr) $ \ file -> do
    let srcDataDir = dataDir pkg_descr
    files <- matchDirFileGlob srcDataDir file
    let dir = takeDirectory file
    createDirectoryIfMissingVerbose verbosity True (destDataDir </> dir)
180
181
    sequence_ [ installOrdinaryFile verbosity (srcDataDir  </> file')
                                              (destDataDir </> file')
182
183
              | file' <- files ]

184
-- | Install the files listed in install-includes
185
--
186
installIncludeFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
187
188
189
190
191
192
installIncludeFiles verbosity
  PackageDescription { library = Just lib } destIncludeDir = do

  incs <- mapM (findInc relincdirs) (installIncludes lbi)
  sequence_
    [ do createDirectoryIfMissingVerbose verbosity True destDir
193
         installOrdinaryFile verbosity srcFile destFile
194
195
196
    | (relFile, srcFile) <- incs
    , let destFile = destIncludeDir </> relFile
          destDir  = takeDirectory destFile ]
197
  where
198
   relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi)
199
   lbi = libBuildInfo lib
200

201
202
203
204
205
   findInc []         file = die ("can't find include file " ++ file)
   findInc (dir:dirs) file = do
     let path = dir </> file
     exists <- doesFileExist path
     if exists then return (file, path) else findInc dirs file
206
installIncludeFiles _ _ _ = die "installIncludeFiles: Can't happen?"