{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Install
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- 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.
module Distribution.Simple.Install
  ( install
  , install_setupHooks
  , installFileGlob
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.CabalSpecVersion (CabalSpecVersion)

import Distribution.Types.ExecutableScope
import Distribution.Types.ForeignLib
import Distribution.Types.LocalBuildInfo
import Distribution.Types.PackageDescription
import Distribution.Types.TargetInfo
import Distribution.Types.UnqualComponentName

import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.BuildPaths (haddockPath, haddockPref)
import Distribution.Simple.BuildTarget
import Distribution.Simple.Compiler
  ( CompilerFlavor (..)
  , compilerFlavor
  )
import Distribution.Simple.Glob (matchDirFileGlob)
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Copy
  ( CopyFlags (..)
  )
import Distribution.Simple.Setup.Haddock
  ( HaddockTarget (ForDevelopment)
  )
import Distribution.Simple.SetupHooks.Internal
  ( InstallHooks (..)
  )
import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks
import Distribution.Simple.Utils
  ( createDirectoryIfMissingVerbose
  , dieWithException
  , info
  , installDirectoryContents
  , installOrdinaryFile
  , isAbsoluteOnAnyPlatform
  , isInSearchPath
  , noticeNoWrap
  , warn
  )
import Distribution.Utils.Path

import Distribution.Compat.Graph (IsNode (..))
import Distribution.Simple.Errors
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import Distribution.Simple.Setup.Common
import qualified Distribution.Simple.UHC as UHC

import System.Directory
  ( doesDirectoryExist
  , doesFileExist
  )
import System.FilePath
  ( takeDirectory
  , takeFileName
  )

import Distribution.Pretty
  ( prettyShow
  )
import Distribution.Verbosity

-- | Perform the \"@.\/setup install@\" and \"@.\/setup copy@\"
--  actions.  Move files into place based on the prefix argument.
--
--  This does NOT register libraries, you should call 'register'
--  to do that.
install
  :: PackageDescription
  -- ^ information from the .cabal file
  -> LocalBuildInfo
  -- ^ information from the configure step
  -> CopyFlags
  -- ^ flags sent to copy or install
  -> IO ()
install :: PackageDescription -> LocalBuildInfo -> CopyFlags -> IO ()
install = InstallHooks
-> PackageDescription -> LocalBuildInfo -> CopyFlags -> IO ()
install_setupHooks InstallHooks
SetupHooks.noInstallHooks

install_setupHooks
  :: InstallHooks
  -> PackageDescription
  -- ^ information from the .cabal file
  -> LocalBuildInfo
  -- ^ information from the configure step
  -> CopyFlags
  -- ^ flags sent to copy or install
  -> IO ()
install_setupHooks :: InstallHooks
-> PackageDescription -> LocalBuildInfo -> CopyFlags -> IO ()
install_setupHooks
  (InstallHooks{Maybe InstallComponentHook
installComponentHook :: Maybe InstallComponentHook
installComponentHook :: InstallHooks -> Maybe InstallComponentHook
installComponentHook})
  PackageDescription
pkg_descr
  LocalBuildInfo
lbi
  CopyFlags
flags = do
    IO ()
checkHasLibsOrExes
    targets <- Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [[Char]]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (CopyFlags -> [[Char]]
copyTargets CopyFlags
flags)

    copyPackage verbosity pkg_descr lbi distPref copydest

    -- It's not necessary to do these in build-order, but it's harmless
    withNeededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) $ \TargetInfo
target -> do
      let comp :: Component
comp = TargetInfo -> Component
targetComponent TargetInfo
target
          clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target
      Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Component
-> ComponentLocalBuildInfo
-> CopyDest
-> IO ()
copyComponent Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Component
comp ComponentLocalBuildInfo
clbi CopyDest
copydest
      Maybe InstallComponentHook
-> (InstallComponentHook -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe InstallComponentHook
installComponentHook ((InstallComponentHook -> IO ()) -> IO ())
-> (InstallComponentHook -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InstallComponentHook
instAction ->
        let inputs :: InstallComponentInputs
inputs =
              SetupHooks.InstallComponentInputs
                { copyFlags :: CopyFlags
copyFlags = CopyFlags
flags
                , localBuildInfo :: LocalBuildInfo
localBuildInfo = LocalBuildInfo
lbi
                , targetInfo :: TargetInfo
targetInfo = TargetInfo
target
                }
         in InstallComponentHook
instAction InstallComponentInputs
inputs
    where
      common :: CommonSetupFlags
common = CopyFlags -> CommonSetupFlags
copyCommonFlags CopyFlags
flags
      distPref :: SymbolicPath Pkg ('Dir Dist)
distPref = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag (SymbolicPath Pkg ('Dir Dist))
 -> SymbolicPath Pkg ('Dir Dist))
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> SymbolicPath Pkg ('Dir Dist)
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref CommonSetupFlags
common
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
      copydest :: CopyDest
copydest = Flag CopyDest -> CopyDest
forall a. WithCallStack (Flag a -> a)
fromFlag (CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags)

      checkHasLibsOrExes :: IO ()
checkHasLibsOrExes =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PackageDescription -> Bool
hasLibs PackageDescription
pkg_descr Bool -> Bool -> Bool
|| PackageDescription -> Bool
hasForeignLibs PackageDescription
pkg_descr Bool -> Bool -> Bool
|| PackageDescription -> Bool
hasExes PackageDescription
pkg_descr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity [Char]
"No executables and no library found. Nothing to do."

-- | Copy package global files.
copyPackage
  :: Verbosity
  -> PackageDescription
  -> LocalBuildInfo
  -> SymbolicPath Pkg (Dir Dist)
  -> CopyDest
  -> IO ()
copyPackage :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist)
-> CopyDest
-> IO ()
copyPackage Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Dist)
distPref CopyDest
copydest = do
  let
    -- This is a bit of a hack, to handle files which are not
    -- per-component (data files and Haddock files.)
    InstallDirs
      { datadir :: forall dir. InstallDirs dir -> dir
datadir = [Char]
dataPref
      , docdir :: forall dir. InstallDirs dir -> dir
docdir = [Char]
docPref
      , htmldir :: forall dir. InstallDirs dir -> dir
htmldir = [Char]
htmlPref
      , haddockdir :: forall dir. InstallDirs dir -> dir
haddockdir = [Char]
interfacePref
      } = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs [Char]
absoluteInstallCommandDirs PackageDescription
pkg_descr LocalBuildInfo
lbi (LocalBuildInfo -> UnitId
localUnitId LocalBuildInfo
lbi) CopyDest
copydest
    mbWorkDir :: Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path

  -- Install (package-global) data files
  Verbosity
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> PackageDescription
-> SymbolicPath Pkg ('Dir DataDir)
-> IO ()
installDataFiles Verbosity
verbosity Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg_descr (SymbolicPath Pkg ('Dir DataDir) -> IO ())
-> SymbolicPath Pkg ('Dir DataDir) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SymbolicPath Pkg ('Dir DataDir)
forall from (to :: FileOrDir). [Char] -> SymbolicPath from to
makeSymbolicPath [Char]
dataPref

  -- Install (package-global) Haddock files
  -- TODO: these should be done per-library
  docExists <- [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i (SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts) -> [Char]
forall a b. (a -> b) -> a -> b
$ HaddockTarget
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
forall root.
HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
haddockPref HaddockTarget
ForDevelopment SymbolicPath Pkg ('Dir Dist)
distPref PackageDescription
pkg_descr
  info
    verbosity
    ( "directory "
        ++ getSymbolicPath (haddockPref ForDevelopment distPref pkg_descr)
        ++ " does exist: "
        ++ show docExists
    )

  -- TODO: this is a bit questionable, Haddock files really should
  -- be per library (when there are convenience libraries.)
  when docExists $ do
    createDirectoryIfMissingVerbose verbosity True htmlPref
    installDirectoryContents
      verbosity
      (i $ haddockPref ForDevelopment distPref pkg_descr)
      htmlPref
    -- setPermissionsRecursive [Read] htmlPref
    -- 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.
    let haddockInterfaceFileSrc =
          HaddockTarget
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
forall root.
HaddockTarget
-> SymbolicPath root ('Dir Dist)
-> PackageDescription
-> SymbolicPath root ('Dir Artifacts)
haddockPref HaddockTarget
ForDevelopment SymbolicPath Pkg ('Dir Dist)
distPref PackageDescription
pkg_descr
            SymbolicPathX 'AllowAbsolute Pkg ('Dir Artifacts)
-> SymbolicPathX 'OnlyRelative Artifacts c3
-> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> SymbolicPathX 'OnlyRelative Artifacts c3
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx (PackageDescription -> [Char]
haddockPath PackageDescription
pkg_descr)
        haddockInterfaceFileDest = [Char]
interfacePref [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> PackageDescription -> [Char]
haddockPath PackageDescription
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 $ i haddockInterfaceFileSrc
    when exists $ do
      createDirectoryIfMissingVerbose verbosity True interfacePref
      installOrdinaryFile
        verbosity
        (i haddockInterfaceFileSrc)
        haddockInterfaceFileDest

  let lfiles = PackageDescription -> [RelativePath Pkg 'File]
licenseFiles PackageDescription
pkg_descr
  unless (null lfiles) $ do
    createDirectoryIfMissingVerbose verbosity True docPref
    for_ lfiles $ \RelativePath Pkg 'File
lfile -> do
      Verbosity -> [Char] -> [Char] -> IO ()
installOrdinaryFile
        Verbosity
verbosity
        (RelativePath Pkg 'File -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i RelativePath Pkg 'File
lfile)
        ([Char]
docPref [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> [Char]
takeFileName (RelativePath Pkg 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath RelativePath Pkg 'File
lfile))

-- | Copy files associated with a component.
copyComponent
  :: Verbosity
  -> PackageDescription
  -> LocalBuildInfo
  -> Component
  -> ComponentLocalBuildInfo
  -> CopyDest
  -> IO ()
copyComponent :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Component
-> ComponentLocalBuildInfo
-> CopyDest
-> IO ()
copyComponent Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (CLib Library
lib) ComponentLocalBuildInfo
clbi CopyDest
copydest = do
  let InstallDirs
        { libdir :: forall dir. InstallDirs dir -> dir
libdir = [Char]
libPref
        , dynlibdir :: forall dir. InstallDirs dir -> dir
dynlibdir = [Char]
dynlibPref
        , includedir :: forall dir. InstallDirs dir -> dir
includedir = [Char]
incPref
        } = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs [Char]
absoluteInstallCommandDirs PackageDescription
pkg_descr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
copydest
      buildPref :: [Char]
buildPref = LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

  case Library -> LibraryName
libName Library
lib of
    LibraryName
LMainLibName -> Verbosity -> [Char] -> IO ()
noticeNoWrap Verbosity
verbosity ([Char]
"Installing library in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
libPref)
    LSubLibName UnqualComponentName
n -> Verbosity -> [Char] -> IO ()
noticeNoWrap Verbosity
verbosity ([Char]
"Installing internal library " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnqualComponentName
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
libPref)

  -- install include files for all compilers - they may be needed to compile
  -- haskell files (using the CPP extension)
  Verbosity
-> BuildInfo -> LocalBuildInfo -> [Char] -> [Char] -> IO ()
installIncludeFiles Verbosity
verbosity (Library -> BuildInfo
libBuildInfo Library
lib) LocalBuildInfo
lbi [Char]
buildPref [Char]
incPref

  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
GHC -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> [Char]
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHC.installLib Verbosity
verbosity LocalBuildInfo
lbi [Char]
libPref [Char]
dynlibPref [Char]
buildPref PackageDescription
pkg_descr Library
lib ComponentLocalBuildInfo
clbi
    CompilerFlavor
GHCJS -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> [Char]
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
GHCJS.installLib Verbosity
verbosity LocalBuildInfo
lbi [Char]
libPref [Char]
dynlibPref [Char]
buildPref PackageDescription
pkg_descr Library
lib ComponentLocalBuildInfo
clbi
    CompilerFlavor
UHC -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> [Char]
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
UHC.installLib Verbosity
verbosity LocalBuildInfo
lbi [Char]
libPref [Char]
dynlibPref [Char]
buildPref PackageDescription
pkg_descr Library
lib ComponentLocalBuildInfo
clbi
    CompilerFlavor
_ ->
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> CabalException
CompilerNotInstalled (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))
copyComponent Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (CFLib ForeignLib
flib) ComponentLocalBuildInfo
clbi CopyDest
copydest = do
  let InstallDirs
        { flibdir :: forall dir. InstallDirs dir -> dir
flibdir = [Char]
flibPref
        , includedir :: forall dir. InstallDirs dir -> dir
includedir = [Char]
incPref
        } = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs [Char]
absoluteComponentInstallDirs PackageDescription
pkg_descr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
copydest
      buildPref :: [Char]
buildPref = LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi

  Verbosity -> [Char] -> IO ()
noticeNoWrap Verbosity
verbosity ([Char]
"Installing foreign library " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> [Char]
unUnqualComponentName (ForeignLib -> UnqualComponentName
foreignLibName ForeignLib
flib) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
flibPref)
  Verbosity
-> BuildInfo -> LocalBuildInfo -> [Char] -> [Char] -> IO ()
installIncludeFiles Verbosity
verbosity (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib) LocalBuildInfo
lbi [Char]
buildPref [Char]
incPref

  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
GHC -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> PackageDescription
-> ForeignLib
-> IO ()
GHC.installFLib Verbosity
verbosity LocalBuildInfo
lbi [Char]
flibPref [Char]
buildPref PackageDescription
pkg_descr ForeignLib
flib
    CompilerFlavor
GHCJS -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> PackageDescription
-> ForeignLib
-> IO ()
GHCJS.installFLib Verbosity
verbosity LocalBuildInfo
lbi [Char]
flibPref [Char]
buildPref PackageDescription
pkg_descr ForeignLib
flib
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> CabalException
CompilerNotInstalled (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))
copyComponent Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi (CExe Executable
exe) ComponentLocalBuildInfo
clbi CopyDest
copydest = do
  let installDirs :: InstallDirs [Char]
installDirs = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs [Char]
absoluteComponentInstallDirs PackageDescription
pkg_descr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
copydest
      -- the installers know how to find the actual location of the
      -- binaries
      buildPref :: [Char]
buildPref = LocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> [Char]
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char])
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build) -> [Char]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi
      uid :: UnitId
uid = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
      pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr
      binPref :: [Char]
binPref
        | ExecutableScope
ExecutablePrivate <- Executable -> ExecutableScope
exeScope Executable
exe = InstallDirs [Char] -> [Char]
forall dir. InstallDirs dir -> dir
libexecdir InstallDirs [Char]
installDirs
        | Bool
otherwise = InstallDirs [Char] -> [Char]
forall dir. InstallDirs dir -> dir
bindir InstallDirs [Char]
installDirs
      progPrefixPref :: [Char]
progPrefixPref = PackageIdentifier
-> LocalBuildInfo -> UnitId -> PathTemplate -> [Char]
substPathTemplate PackageIdentifier
pkgid LocalBuildInfo
lbi UnitId
uid (LocalBuildInfo -> PathTemplate
progPrefix LocalBuildInfo
lbi)
      progSuffixPref :: [Char]
progSuffixPref = PackageIdentifier
-> LocalBuildInfo -> UnitId -> PathTemplate -> [Char]
substPathTemplate PackageIdentifier
pkgid LocalBuildInfo
lbi UnitId
uid (LocalBuildInfo -> PathTemplate
progSuffix LocalBuildInfo
lbi)
      progFix :: ([Char], [Char])
progFix = ([Char]
progPrefixPref, [Char]
progSuffixPref)
  Verbosity -> [Char] -> IO ()
noticeNoWrap
    Verbosity
verbosity
    ( [Char]
"Installing executable "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (Executable -> UnqualComponentName
exeName Executable
exe)
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
binPref
    )
  inPath <- [Char] -> IO Bool
isInSearchPath [Char]
binPref
  when (not inPath) $
    warn
      verbosity
      ( "The directory "
          ++ binPref
          ++ " is not in the system search path."
      )
  case compilerFlavor (compiler lbi) of
    CompilerFlavor
GHC -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> ([Char], [Char])
-> PackageDescription
-> Executable
-> IO ()
GHC.installExe Verbosity
verbosity LocalBuildInfo
lbi [Char]
binPref [Char]
buildPref ([Char], [Char])
progFix PackageDescription
pkg_descr Executable
exe
    CompilerFlavor
GHCJS -> Verbosity
-> LocalBuildInfo
-> [Char]
-> [Char]
-> ([Char], [Char])
-> PackageDescription
-> Executable
-> IO ()
GHCJS.installExe Verbosity
verbosity LocalBuildInfo
lbi [Char]
binPref [Char]
buildPref ([Char], [Char])
progFix PackageDescription
pkg_descr Executable
exe
    CompilerFlavor
UHC -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    CompilerFlavor
_ ->
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> CabalException
CompilerNotInstalled (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi))

-- Nothing to do for benchmark/testsuite
copyComponent Verbosity
_ PackageDescription
_ LocalBuildInfo
_ (CBench Benchmark
_) ComponentLocalBuildInfo
_ CopyDest
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
copyComponent Verbosity
_ PackageDescription
_ LocalBuildInfo
_ (CTest TestSuite
_) ComponentLocalBuildInfo
_ CopyDest
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Install the files listed in data-files
installDataFiles
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> PackageDescription
  -> SymbolicPath Pkg (Dir DataDir)
  -> IO ()
installDataFiles :: Verbosity
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> PackageDescription
-> SymbolicPath Pkg ('Dir DataDir)
-> IO ()
installDataFiles Verbosity
verbosity Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg_descr SymbolicPath Pkg ('Dir DataDir)
destDataDir =
  (SymbolicPathX 'OnlyRelative DataDir 'File -> IO ())
-> [SymbolicPathX 'OnlyRelative DataDir 'File] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
    (Verbosity
-> CabalSpecVersion
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> (Maybe (SymbolicPath CWD ('Dir DataDir)),
    SymbolicPath Pkg ('Dir DataDir))
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> IO ()
installFileGlob Verbosity
verbosity (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir (Maybe (SymbolicPath CWD ('Dir DataDir))
srcDataDir, SymbolicPath Pkg ('Dir DataDir)
destDataDir))
    (PackageDescription -> [SymbolicPathX 'OnlyRelative DataDir 'File]
dataFiles PackageDescription
pkg_descr)
  where
    srcDataDirRaw :: [Char]
srcDataDirRaw = SymbolicPath Pkg ('Dir DataDir) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (SymbolicPath Pkg ('Dir DataDir) -> [Char])
-> SymbolicPath Pkg ('Dir DataDir) -> [Char]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> SymbolicPath Pkg ('Dir DataDir)
dataDir PackageDescription
pkg_descr
    srcDataDir :: Maybe (SymbolicPath CWD (Dir DataDir))
    srcDataDir :: Maybe (SymbolicPath CWD ('Dir DataDir))
srcDataDir
      | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
srcDataDirRaw =
          Maybe (SymbolicPath CWD ('Dir DataDir))
forall a. Maybe a
Nothing
      | [Char] -> Bool
isAbsoluteOnAnyPlatform [Char]
srcDataDirRaw =
          SymbolicPath CWD ('Dir DataDir)
-> Maybe (SymbolicPath CWD ('Dir DataDir))
forall a. a -> Maybe a
Just (SymbolicPath CWD ('Dir DataDir)
 -> Maybe (SymbolicPath CWD ('Dir DataDir)))
-> SymbolicPath CWD ('Dir DataDir)
-> Maybe (SymbolicPath CWD ('Dir DataDir))
forall a b. (a -> b) -> a -> b
$ [Char] -> SymbolicPath CWD ('Dir DataDir)
forall from (to :: FileOrDir). [Char] -> SymbolicPath from to
makeSymbolicPath [Char]
srcDataDirRaw
      | Bool
otherwise =
          SymbolicPath CWD ('Dir DataDir)
-> Maybe (SymbolicPath CWD ('Dir DataDir))
forall a. a -> Maybe a
Just (SymbolicPath CWD ('Dir DataDir)
 -> Maybe (SymbolicPath CWD ('Dir DataDir)))
-> SymbolicPath CWD ('Dir DataDir)
-> Maybe (SymbolicPath CWD ('Dir DataDir))
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg)
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg)
forall a. a -> Maybe a -> a
fromMaybe SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg)
-> SymbolicPathX 'OnlyRelative Pkg ('Dir DataDir)
-> SymbolicPath CWD ('Dir DataDir)
forall p q r. PathLike p q r => p -> q -> r
</> [Char] -> SymbolicPathX 'OnlyRelative Pkg ('Dir DataDir)
forall from (to :: FileOrDir).
HasCallStack =>
[Char] -> RelativePath from to
makeRelativePathEx [Char]
srcDataDirRaw

-- | Install the files specified by the given glob pattern.
installFileGlob
  :: Verbosity
  -> CabalSpecVersion
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> (Maybe (SymbolicPath CWD (Dir DataDir)), SymbolicPath Pkg (Dir DataDir))
  -- ^ @(src_dir, dest_dir)@
  -> RelativePath DataDir File
  -- ^ file glob pattern
  -> IO ()
installFileGlob :: Verbosity
-> CabalSpecVersion
-> Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> (Maybe (SymbolicPath CWD ('Dir DataDir)),
    SymbolicPath Pkg ('Dir DataDir))
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> IO ()
installFileGlob Verbosity
verbosity CabalSpecVersion
spec_version Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir (Maybe (SymbolicPath CWD ('Dir DataDir))
srcDir, SymbolicPath Pkg ('Dir DataDir)
destDir) SymbolicPathX 'OnlyRelative DataDir 'File
glob = do
  files <- Verbosity
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir DataDir))
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> IO [SymbolicPathX 'OnlyRelative DataDir 'File]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlob Verbosity
verbosity CabalSpecVersion
spec_version Maybe (SymbolicPath CWD ('Dir DataDir))
srcDir SymbolicPathX 'OnlyRelative DataDir 'File
glob
  for_ files $ \SymbolicPathX 'OnlyRelative DataDir 'File
file' -> do
    let src :: [Char]
src = SymbolicPathX 'AllowAbsolute CWD 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (SymbolicPath CWD ('Dir DataDir)
-> Maybe (SymbolicPath CWD ('Dir DataDir))
-> SymbolicPath CWD ('Dir DataDir)
forall a. a -> Maybe a -> a
fromMaybe SymbolicPath CWD ('Dir DataDir)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory Maybe (SymbolicPath CWD ('Dir DataDir))
srcDir SymbolicPath CWD ('Dir DataDir)
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> SymbolicPathX 'AllowAbsolute CWD 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative DataDir 'File
file')
        dst :: [Char]
dst = Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPathX 'AllowAbsolute CWD ('Dir Pkg))
mbWorkDir (SymbolicPath Pkg ('Dir DataDir)
destDir SymbolicPath Pkg ('Dir DataDir)
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative DataDir 'File
file')
    Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True ([Char] -> [Char]
takeDirectory [Char]
dst)
    Verbosity -> [Char] -> [Char] -> IO ()
installOrdinaryFile Verbosity
verbosity [Char]
src [Char]
dst

-- | Install the files listed in install-includes for a library
installIncludeFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
installIncludeFiles :: Verbosity
-> BuildInfo -> LocalBuildInfo -> [Char] -> [Char] -> IO ()
installIncludeFiles Verbosity
verbosity BuildInfo
libBi LocalBuildInfo
lbi [Char]
buildPref [Char]
destIncludeDir = do
  let relincdirs :: [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
relincdirs = SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a. a -> [a] -> [a]
: (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
 -> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include)))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
-> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
includeDirs BuildInfo
libBi)
      incdirs :: [[Char]]
incdirs =
        [ [Char]
root [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Pkg ('Dir Include) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir
        | -- NB: both baseDir and buildPref are already interpreted,
        -- so we don't need to interpret these paths in the call to findInc.
        SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir <- [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
relincdirs
        , [Char]
root <- [LocalBuildInfo -> [Char]
baseDir LocalBuildInfo
lbi, [Char]
buildPref]
        ]
  incs <- (SymbolicPathX 'OnlyRelative Include 'File -> IO ([Char], [Char]))
-> [SymbolicPathX 'OnlyRelative Include 'File]
-> IO [([Char], [Char])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([[Char]] -> [Char] -> IO ([Char], [Char])
findInc [[Char]]
incdirs ([Char] -> IO ([Char], [Char]))
-> (SymbolicPathX 'OnlyRelative Include 'File -> [Char])
-> SymbolicPathX 'OnlyRelative Include 'File
-> IO ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative Include 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath) (BuildInfo -> [SymbolicPathX 'OnlyRelative Include 'File]
installIncludes BuildInfo
libBi)
  sequence_
    [ do
      createDirectoryIfMissingVerbose verbosity True destDir
      installOrdinaryFile verbosity srcFile destFile
    | (relFile, srcFile) <- incs
    , let destFile = [Char]
destIncludeDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
relFile
          destDir = [Char] -> [Char]
takeDirectory [Char]
destFile
    ]
  where
    baseDir :: LocalBuildInfo -> [Char]
baseDir LocalBuildInfo
lbi' = CommonSetupFlags -> [Char]
packageRoot (CommonSetupFlags -> [Char]) -> CommonSetupFlags -> [Char]
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> ConfigFlags -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi'
    findInc :: [[Char]] -> [Char] -> IO ([Char], [Char])
findInc [] [Char]
file = Verbosity -> CabalException -> IO ([Char], [Char])
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ([Char], [Char]))
-> CabalException -> IO ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
CantFindIncludeFile [Char]
file
    findInc ([Char]
dir : [[Char]]
dirs) [Char]
file = do
      let path :: [Char]
path = [Char]
dir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
file
      exists <- [Char] -> IO Bool
doesFileExist [Char]
path
      if exists then return (file, path) else findInc dirs file