Cabal/src/Distribution/Simple/Install.hs

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