1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE RankNTypes #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.Simple.Install
7-- Copyright   :  Isaac Jones 2003-2004
8-- License     :  BSD3
9--
10-- Maintainer  :  cabal-devel@haskell.org
11-- Portability :  portable
12--
13-- This is the entry point into installing a built package. Performs the
14-- \"@.\/setup install@\" and \"@.\/setup copy@\" actions. It moves files into
15-- place based on the prefix argument. It does the generic bits and then calls
16-- compiler-specific functions to do the rest.
17
18module Distribution.Simple.Install (
19        install,
20  ) where
21
22import Prelude ()
23import Distribution.Compat.Prelude
24
25import Distribution.Types.TargetInfo
26import Distribution.Types.LocalBuildInfo
27import Distribution.Types.ForeignLib
28import Distribution.Types.PackageDescription
29import Distribution.Types.UnqualComponentName
30import Distribution.Types.ExecutableScope
31
32import Distribution.Package
33import Distribution.PackageDescription
34import Distribution.Simple.LocalBuildInfo
35import Distribution.Simple.BuildPaths (haddockName, haddockPref)
36import Distribution.Simple.Glob (matchDirFileGlob)
37import Distribution.Simple.Utils
38         ( createDirectoryIfMissingVerbose
39         , installDirectoryContents, installOrdinaryFile, isInSearchPath
40         , die', info, noticeNoWrap, warn )
41import Distribution.Simple.Compiler
42         ( CompilerFlavor(..), compilerFlavor )
43import Distribution.Simple.Setup
44         ( CopyFlags(..), fromFlag, HaddockTarget(ForDevelopment) )
45import Distribution.Simple.BuildTarget
46
47import qualified Distribution.Simple.GHC   as GHC
48import qualified Distribution.Simple.GHCJS as GHCJS
49import qualified Distribution.Simple.UHC   as UHC
50import qualified Distribution.Simple.HaskellSuite as HaskellSuite
51import Distribution.Compat.Graph (IsNode(..))
52
53import System.Directory
54         ( doesDirectoryExist, doesFileExist )
55import System.FilePath
56         ( takeFileName, takeDirectory, (</>), isRelative )
57
58import Distribution.Verbosity
59import Distribution.Pretty
60         ( prettyShow )
61
62-- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\"
63-- actions.  Move files into place based on the prefix argument.
64--
65-- This does NOT register libraries, you should call 'register'
66-- to do that.
67
68install :: PackageDescription -- ^information from the .cabal file
69        -> LocalBuildInfo -- ^information from the configure step
70        -> CopyFlags -- ^flags sent to copy or install
71        -> IO ()
72install pkg_descr lbi flags = do
73  checkHasLibsOrExes
74  targets <- readTargetInfos verbosity pkg_descr lbi (copyArgs flags)
75
76  copyPackage verbosity pkg_descr lbi distPref copydest
77
78  -- It's not necessary to do these in build-order, but it's harmless
79  withNeededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) $ \target ->
80    let comp = targetComponent target
81        clbi = targetCLBI target
82    in copyComponent verbosity pkg_descr lbi comp clbi copydest
83 where
84  distPref  = fromFlag (copyDistPref flags)
85  verbosity = fromFlag (copyVerbosity flags)
86  copydest  = fromFlag (copyDest flags)
87
88  checkHasLibsOrExes =
89    unless (hasLibs pkg_descr || hasForeignLibs pkg_descr || hasExes pkg_descr) $
90      die' verbosity "No executables and no library found. Nothing to do."
91
92-- | Copy package global files.
93copyPackage :: Verbosity -> PackageDescription
94            -> LocalBuildInfo -> FilePath -> CopyDest -> IO ()
95copyPackage verbosity pkg_descr lbi distPref copydest = do
96  let -- This is a bit of a hack, to handle files which are not
97      -- per-component (data files and Haddock files.)
98      InstallDirs {
99         datadir    = dataPref,
100         docdir     = docPref,
101         htmldir    = htmlPref,
102         haddockdir = interfacePref
103      } = absoluteInstallCommandDirs pkg_descr lbi (localUnitId lbi) copydest
104
105  -- Install (package-global) data files
106  installDataFiles verbosity pkg_descr dataPref
107
108  -- Install (package-global) Haddock files
109  -- TODO: these should be done per-library
110  docExists <- doesDirectoryExist $ haddockPref ForDevelopment distPref pkg_descr
111  info verbosity ("directory " ++ haddockPref ForDevelopment distPref pkg_descr ++
112                  " does exist: " ++ show docExists)
113
114  -- TODO: this is a bit questionable, Haddock files really should
115  -- be per library (when there are convenience libraries.)
116  when docExists $ do
117      createDirectoryIfMissingVerbose verbosity True htmlPref
118      installDirectoryContents verbosity
119          (haddockPref ForDevelopment distPref pkg_descr) htmlPref
120      -- setPermissionsRecursive [Read] htmlPref
121      -- The haddock interface file actually already got installed
122      -- in the recursive copy, but now we install it where we actually
123      -- want it to be (normally the same place). We could remove the
124      -- copy in htmlPref first.
125      let haddockInterfaceFileSrc  = haddockPref ForDevelopment distPref pkg_descr
126                                                   </> haddockName pkg_descr
127          haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr
128      -- We only generate the haddock interface file for libs, So if the
129      -- package consists only of executables there will not be one:
130      exists <- doesFileExist haddockInterfaceFileSrc
131      when exists $ do
132        createDirectoryIfMissingVerbose verbosity True interfacePref
133        installOrdinaryFile verbosity haddockInterfaceFileSrc
134                                      haddockInterfaceFileDest
135
136  let lfiles = licenseFiles pkg_descr
137  unless (null lfiles) $ do
138    createDirectoryIfMissingVerbose verbosity True docPref
139    sequence_
140      [ installOrdinaryFile verbosity lfile (docPref </> takeFileName lfile)
141      | lfile <- lfiles ]
142
143-- | Copy files associated with a component.
144copyComponent :: Verbosity -> PackageDescription
145              -> LocalBuildInfo -> Component -> ComponentLocalBuildInfo
146              -> CopyDest
147              -> IO ()
148copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
149    let InstallDirs{
150            libdir = libPref,
151            dynlibdir = dynlibPref,
152            includedir = incPref
153            } = absoluteInstallCommandDirs pkg_descr lbi (componentUnitId clbi) copydest
154        buildPref = componentBuildDir lbi clbi
155
156    case libName lib of
157        LMainLibName  -> noticeNoWrap verbosity ("Installing library in " ++ libPref)
158        LSubLibName n -> noticeNoWrap verbosity ("Installing internal library " ++ prettyShow n ++ " in " ++ libPref)
159
160    -- install include files for all compilers - they may be needed to compile
161    -- haskell files (using the CPP extension)
162    installIncludeFiles verbosity (libBuildInfo lib) lbi buildPref incPref
163
164    case compilerFlavor (compiler lbi) of
165      GHC   -> GHC.installLib   verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
166      GHCJS -> GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
167      UHC   -> UHC.installLib   verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
168      HaskellSuite _ -> HaskellSuite.installLib
169                                verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi
170      _ -> die' verbosity $ "installing with "
171              ++ prettyShow (compilerFlavor (compiler lbi))
172              ++ " is not implemented"
173
174copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do
175    let InstallDirs{
176            flibdir = flibPref,
177            includedir = incPref
178            } = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
179        buildPref = componentBuildDir lbi clbi
180
181    noticeNoWrap verbosity ("Installing foreign library " ++ unUnqualComponentName (foreignLibName flib) ++ " in " ++ flibPref)
182    installIncludeFiles verbosity (foreignLibBuildInfo flib) lbi buildPref incPref
183
184    case compilerFlavor (compiler lbi) of
185      GHC   -> GHC.installFLib   verbosity lbi flibPref buildPref pkg_descr flib
186      GHCJS -> GHCJS.installFLib verbosity lbi flibPref buildPref pkg_descr flib
187      _ -> die' verbosity $ "installing foreign lib with "
188              ++ prettyShow (compilerFlavor (compiler lbi))
189              ++ " is not implemented"
190
191copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
192    let installDirs = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
193        -- the installers know how to find the actual location of the
194        -- binaries
195        buildPref = buildDir lbi
196        uid = componentUnitId clbi
197        pkgid = packageId pkg_descr
198        binPref | ExecutablePrivate <- exeScope exe = libexecdir installDirs
199                | otherwise = bindir installDirs
200        progPrefixPref = substPathTemplate pkgid lbi uid (progPrefix lbi)
201        progSuffixPref = substPathTemplate pkgid lbi uid (progSuffix lbi)
202        progFix = (progPrefixPref, progSuffixPref)
203    noticeNoWrap verbosity ("Installing executable " ++ prettyShow (exeName exe)
204                      ++ " in " ++ binPref)
205    inPath <- isInSearchPath binPref
206    when (not inPath) $
207      warn verbosity ("The directory " ++ binPref
208                      ++ " is not in the system search path.")
209    case compilerFlavor (compiler lbi) of
210      GHC   -> GHC.installExe   verbosity lbi binPref buildPref progFix pkg_descr exe
211      GHCJS -> GHCJS.installExe verbosity lbi binPref buildPref progFix pkg_descr exe
212      UHC   -> return ()
213      HaskellSuite {} -> return ()
214      _ -> die' verbosity $ "installing with "
215              ++ prettyShow (compilerFlavor (compiler lbi))
216              ++ " is not implemented"
217
218-- Nothing to do for benchmark/testsuite
219copyComponent _ _ _ (CBench _) _ _ = return ()
220copyComponent _ _ _ (CTest _) _ _ = return ()
221
222-- | Install the files listed in data-files
223--
224installDataFiles :: Verbosity -> PackageDescription -> FilePath -> IO ()
225installDataFiles verbosity pkg_descr destDataDir =
226  flip traverse_ (dataFiles pkg_descr) $ \ glob -> do
227    let srcDataDirRaw = dataDir pkg_descr
228        srcDataDir = if null srcDataDirRaw
229          then "."
230          else srcDataDirRaw
231    files <- matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir glob
232    for_ files $ \ file' -> do
233      let src = srcDataDir </> file'
234          dst = destDataDir </> file'
235      createDirectoryIfMissingVerbose verbosity True (takeDirectory dst)
236      installOrdinaryFile verbosity src dst
237
238-- | Install the files listed in install-includes for a library
239--
240installIncludeFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
241installIncludeFiles verbosity libBi lbi buildPref destIncludeDir = do
242    let relincdirs = "." : filter isRelative (includeDirs libBi)
243        incdirs = [ baseDir lbi </> dir | dir <- relincdirs ]
244                  ++ [ buildPref </> dir | dir <- relincdirs ]
245    incs <- traverse (findInc incdirs) (installIncludes libBi)
246    sequence_
247      [ do createDirectoryIfMissingVerbose verbosity True destDir
248           installOrdinaryFile verbosity srcFile destFile
249      | (relFile, srcFile) <- incs
250      , let destFile = destIncludeDir </> relFile
251            destDir  = takeDirectory destFile ]
252  where
253   baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
254   findInc []         file = die' verbosity ("can't find include file " ++ file)
255   findInc (dir:dirs) file = do
256     let path = dir </> file
257     exists <- doesFileExist path
258     if exists then return (file, path) else findInc dirs file
259