Cabal/src/Distribution/Simple/Install.hs

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