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