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

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

-- |
-- Module      :  Distribution.Simple.Register
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module deals with registering and unregistering packages. There are a
-- couple ways it can do this, one is to do it directly. Another is to generate
-- a script that can be run later to do it. The idea here being that the user
-- is shielded from the details of what command to use for package registration
-- for a particular compiler. In practice this aspect was not especially
-- popular so we also provide a way to simply generate the package registration
-- file which then must be manually passed to @ghc-pkg@. It is possible to
-- generate registration information for where the package is to be installed,
-- or alternatively to register the package in place in the build tree. The
-- latter is occasionally handy, and will become more important when we try to
-- build multi-package systems.
--
-- This module does not delegate anything to the per-compiler modules but just
-- mixes it all in this module, which is rather unsatisfactory. The script
-- generation and the unregister feature are not well used or tested.
module Distribution.Simple.Register
  ( register
  , unregister
  , internalPackageDBPath
  , initPackageDB
  , doesPackageDBExist
  , createPackageDB
  , deletePackageDB
  , abiHash
  , invokeHcPkg
  , registerPackage
  , HcPkg.RegisterOptions (..)
  , HcPkg.defaultRegisterOptions
  , generateRegistrationInfo
  , inplaceInstalledPackageInfo
  , absoluteInstalledPackageInfo
  , generalInstalledPackageInfo
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo

import Distribution.Simple.BuildPaths
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo

import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.PackageIndex as Index
import qualified Distribution.Simple.UHC as UHC

import Distribution.Backpack.DescribeUnitId
import Distribution.Compat.Graph (IsNode (nodeKey))
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.License (licenseFromSPDX, licenseToSPDX)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Program.Script
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Register
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Utils.MapAccum
import Distribution.Utils.Path
import Distribution.Verbosity as Verbosity
import Distribution.Version
import System.Directory
import System.FilePath (isAbsolute)

import qualified Data.ByteString.Lazy.Char8 as BS.Char8

-- -----------------------------------------------------------------------------
-- Registration

register
  :: PackageDescription
  -> LocalBuildInfo
  -> RegisterFlags
  -- ^ Install in the user's database?; verbose
  -> IO ()
register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
register PackageDescription
pkg_descr LocalBuildInfo
lbi0 RegisterFlags
flags = do
  -- Duncan originally asked for us to not register/install files
  -- when there was no public library.  But with per-component
  -- configure, we legitimately need to install internal libraries
  -- so that we can get them.  So just unconditionally install.
  let 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
$ RegisterFlags -> Flag Verbosity
registerVerbosity RegisterFlags
flags
  targets <- Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [FilePath]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi0 ([FilePath] -> IO [TargetInfo]) -> [FilePath] -> IO [TargetInfo]
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> [FilePath]
registerTargets RegisterFlags
flags

  -- It's important to register in build order, because ghc-pkg
  -- will complain if a dependency is not registered.
  let componentsToRegister =
        PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi0 ((TargetInfo -> UnitId) -> [TargetInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map TargetInfo -> Key TargetInfo
TargetInfo -> UnitId
forall a. IsNode a => a -> Key a
nodeKey [TargetInfo]
targets)

  (_, ipi_mbs) <-
    mapAccumM `flip` installedPkgs lbi0 `flip` componentsToRegister $ \InstalledPackageIndex
index TargetInfo
tgt ->
      case TargetInfo -> Component
targetComponent TargetInfo
tgt of
        CLib Library
lib -> do
          let clbi :: ComponentLocalBuildInfo
clbi = TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
tgt
              lbi :: LocalBuildInfo
lbi = LocalBuildInfo
lbi0{installedPkgs = index}
          ipi <- PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> RegisterFlags
-> IO InstalledPackageInfo
generateOne PackageDescription
pkg_descr Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi RegisterFlags
flags
          return (Index.insert ipi index, Just ipi)
        Component
_ -> (InstalledPackageIndex, Maybe InstalledPackageInfo)
-> IO (InstalledPackageIndex, Maybe InstalledPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex
index, Maybe InstalledPackageInfo
forall a. Maybe a
Nothing)

  registerAll pkg_descr lbi0 flags (catMaybes ipi_mbs)

generateOne
  :: PackageDescription
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> RegisterFlags
  -> IO InstalledPackageInfo
generateOne :: PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> RegisterFlags
-> IO InstalledPackageInfo
generateOne PackageDescription
pkg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi RegisterFlags
regFlags =
  do
    absPackageDBs <- Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack -> IO PackageDBStack
absolutePackageDBPaths Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBStack
packageDbs
    installedPkgInfo <-
      generateRegistrationInfo
        verbosity
        pkg
        lib
        lbi
        clbi
        inplace
        reloc
        distPref
        (registrationPackageDB absPackageDBs)
    info verbosity (IPI.showInstalledPackageInfo installedPkgInfo)
    return installedPkgInfo
  where
    common :: CommonSetupFlags
common = RegisterFlags -> CommonSetupFlags
registerCommonFlags RegisterFlags
regFlags
    inplace :: Bool
inplace = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Bool
regInPlace RegisterFlags
regFlags)
    reloc :: Bool
reloc = LocalBuildInfo -> Bool
relocatable LocalBuildInfo
lbi
    -- FIXME: there's really no guarantee this will work.
    -- registering into a totally different db stack can
    -- fail if dependencies cannot be satisfied.
    packageDbs :: PackageDBStack
packageDbs =
      PackageDBStack -> PackageDBStack
forall a. Eq a => [a] -> [a]
nub (PackageDBStack -> PackageDBStack)
-> PackageDBStack -> PackageDBStack
forall a b. (a -> b) -> a -> b
$
        LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
          PackageDBStack -> PackageDBStack -> PackageDBStack
forall a. [a] -> [a] -> [a]
++ Maybe PackageDB -> PackageDBStack
forall a. Maybe a -> [a]
maybeToList (Flag PackageDB -> Maybe PackageDB
forall a. Flag a -> Maybe a
flagToMaybe (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags))
    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
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir CommonSetupFlags
common

registerAll
  :: PackageDescription
  -> LocalBuildInfo
  -> RegisterFlags
  -> [InstalledPackageInfo]
  -> IO ()
registerAll :: PackageDescription
-> LocalBuildInfo
-> RegisterFlags
-> [InstalledPackageInfo]
-> IO ()
registerAll PackageDescription
pkg LocalBuildInfo
lbi RegisterFlags
regFlags [InstalledPackageInfo]
ipis =
  do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Bool
regPrintId RegisterFlags
regFlags)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [InstalledPackageInfo] -> (InstalledPackageInfo -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [InstalledPackageInfo]
ipis ((InstalledPackageInfo -> IO ()) -> IO ())
-> (InstalledPackageInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InstalledPackageInfo
installedPkgInfo ->
        -- Only print the public library's IPI
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          ( InstalledPackageInfo -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
installedPkgInfo PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
              Bool -> Bool -> Bool
&& InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
installedPkgInfo LibraryName -> LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName
LMainLibName
          )
          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (InstalledPackageInfo -> UnitId
IPI.installedUnitId InstalledPackageInfo
installedPkgInfo))

    -- Three different modes:
    case () of
      ()
_
        | Bool
modeGenerateRegFile -> IO ()
writeRegistrationFileOrDirectory
        | Bool
modeGenerateRegScript -> IO ()
writeRegisterScript
        | Bool
otherwise -> do
            [InstalledPackageInfo] -> (InstalledPackageInfo -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [InstalledPackageInfo]
ipis ((InstalledPackageInfo -> IO ()) -> IO ())
-> (InstalledPackageInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InstalledPackageInfo
ipi -> do
              Verbosity
-> FilePath
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, OpenModule)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> FilePath
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage'
                Verbosity
verbosity
                FilePath
"Registering"
                (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg)
                (LibraryName -> ComponentName
CLibName (InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
ipi))
                ([(ModuleName, OpenModule)] -> Maybe [(ModuleName, OpenModule)]
forall a. a -> Maybe a
Just (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
ipi))
              Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
forall from.
Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage
                Verbosity
verbosity
                (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
                (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
                (LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi)
                PackageDBStack
packageDbs
                InstalledPackageInfo
ipi
                RegisterOptions
HcPkg.defaultRegisterOptions
  where
    modeGenerateRegFile :: Bool
modeGenerateRegFile = Maybe (Maybe (SymbolicPath Pkg ('Dir PkgConf))) -> Bool
forall a. Maybe a -> Bool
isJust (Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
-> Maybe (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
forall a. Flag a -> Maybe a
flagToMaybe (RegisterFlags -> Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
regGenPkgConf RegisterFlags
regFlags))
    regFile :: FilePath
regFile =
      LocalBuildInfo -> SymbolicPath Pkg ('Dir PkgConf) -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPath Pkg ('Dir PkgConf) -> FilePath)
-> SymbolicPath Pkg ('Dir PkgConf) -> FilePath
forall a b. (a -> b) -> a -> b
$
        SymbolicPath Pkg ('Dir PkgConf)
-> Maybe (SymbolicPath Pkg ('Dir PkgConf))
-> SymbolicPath Pkg ('Dir PkgConf)
forall a. a -> Maybe a -> a
fromMaybe
          (FilePath -> SymbolicPath Pkg ('Dir PkgConf)
forall from (to :: FileOrDir). FilePath -> SymbolicPath from to
makeSymbolicPath (PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) FilePath -> FilePath -> FilePath
forall p. FileLike p => p -> FilePath -> p
<.> FilePath
"conf"))
          (Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
-> Maybe (SymbolicPath Pkg ('Dir PkgConf))
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag (Maybe (SymbolicPath Pkg ('Dir PkgConf)))
regGenPkgConf RegisterFlags
regFlags))

    modeGenerateRegScript :: Bool
modeGenerateRegScript = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Bool
regGenScript RegisterFlags
regFlags)

    -- FIXME: there's really no guarantee this will work.
    -- registering into a totally different db stack can
    -- fail if dependencies cannot be satisfied.
    packageDbs :: PackageDBStack
packageDbs =
      PackageDBStack -> PackageDBStack
forall a. Eq a => [a] -> [a]
nub (PackageDBStack -> PackageDBStack)
-> PackageDBStack -> PackageDBStack
forall a b. (a -> b) -> a -> b
$
        LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
          PackageDBStack -> PackageDBStack -> PackageDBStack
forall a. [a] -> [a] -> [a]
++ Maybe PackageDB -> PackageDBStack
forall a. Maybe a -> [a]
maybeToList (Flag PackageDB -> Maybe PackageDB
forall a. Flag a -> Maybe a
flagToMaybe (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags))
    common :: CommonSetupFlags
common = RegisterFlags -> CommonSetupFlags
registerCommonFlags RegisterFlags
regFlags
    verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common)
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi

    writeRegistrationFileOrDirectory :: IO ()
writeRegistrationFileOrDirectory = do
      -- Handles overwriting both directory and file
      FilePath -> IO ()
deletePackageDB FilePath
regFile
      case [InstalledPackageInfo]
ipis of
        [InstalledPackageInfo
installedPkgInfo] -> do
          Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Creating package registration file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
regFile)
          FilePath -> FilePath -> IO ()
writeUTF8File FilePath
regFile (InstalledPackageInfo -> FilePath
IPI.showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo)
        [InstalledPackageInfo]
_ -> do
          Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Creating package registration directory: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
regFile)
          FilePath -> IO ()
createDirectory FilePath
regFile
          let num_ipis :: Int
num_ipis = [InstalledPackageInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
ipis
              lpad :: Int -> FilePath -> FilePath
lpad Int
m FilePath
xs = Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ys) Char
'0' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ys
                where
                  ys :: FilePath
ys = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
m FilePath
xs
              number :: a -> FilePath
number a
i = Int -> FilePath -> FilePath
lpad (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
num_ipis)) (a -> FilePath
forall a. Show a => a -> FilePath
show a
i)
          [(Int, InstalledPackageInfo)]
-> ((Int, InstalledPackageInfo) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int] -> [InstalledPackageInfo] -> [(Int, InstalledPackageInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
1 ..] :: [Int]) [InstalledPackageInfo]
ipis) (((Int, InstalledPackageInfo) -> IO ()) -> IO ())
-> ((Int, InstalledPackageInfo) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, InstalledPackageInfo
installedPkgInfo) ->
            FilePath -> FilePath -> IO ()
writeUTF8File
              (FilePath
regFile FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> (Int -> FilePath
forall a. Show a => a -> FilePath
number Int
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (InstalledPackageInfo -> UnitId
IPI.installedUnitId InstalledPackageInfo
installedPkgInfo)))
              (InstalledPackageInfo -> FilePath
IPI.showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo)

    writeRegisterScript :: IO ()
writeRegisterScript =
      case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        CompilerFlavor
UHC -> Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity FilePath
"Registration scripts not needed for uhc"
        CompilerFlavor
_ ->
          Verbosity
-> FilePath
-> Compiler
-> ProgramDb
-> (HcPkgInfo -> IO ())
-> IO ()
forall a.
Verbosity
-> FilePath -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg
            Verbosity
verbosity
            FilePath
"Registration scripts are not implemented for this compiler"
            (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
            (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
            (Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [InstalledPackageInfo]
-> PackageDBStack
-> HcPkgInfo
-> IO ()
writeHcPkgRegisterScript Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [InstalledPackageInfo]
ipis PackageDBStack
packageDbs)

generateRegistrationInfo
  :: Verbosity
  -> PackageDescription
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> Bool
  -> Bool
  -> SymbolicPath Pkg (Dir Dist)
  -> PackageDB
  -> IO InstalledPackageInfo
generateRegistrationInfo :: Verbosity
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Bool
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDB
-> IO InstalledPackageInfo
generateRegistrationInfo Verbosity
verbosity PackageDescription
pkg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
inplace Bool
reloc SymbolicPath Pkg ('Dir Dist)
distPref PackageDB
packageDb = do
  inplaceDir <- LocalBuildInfo -> IO (AbsolutePath ('Dir Pkg))
absoluteWorkingDirLBI LocalBuildInfo
lbi
  installedPkgInfo <-
    if inplace
      then -- NB: With an inplace installation, the user may run './Setup
      -- build' to update the library files, without reregistering.
      -- In this case, it is critical that the ABI hash not flip.

        return
          ( inplaceInstalledPackageInfo
              inplaceDir
              distPref
              pkg
              (mkAbiHash "inplace")
              lib
              lbi
              clbi
          )
      else do
        abi_hash <- abiHash verbosity pkg distPref lbi lib clbi
        if reloc
          then
            relocRegistrationInfo
              verbosity
              pkg
              lib
              lbi
              clbi
              abi_hash
              packageDb
          else
            return
              ( absoluteInstalledPackageInfo
                  pkg
                  abi_hash
                  lib
                  lbi
                  clbi
              )

  return installedPkgInfo

-- | Compute the 'AbiHash' of a library that we built inplace.
abiHash
  :: Verbosity
  -> PackageDescription
  -> SymbolicPath Pkg (Dir Dist)
  -> LocalBuildInfo
  -> Library
  -> ComponentLocalBuildInfo
  -> IO AbiHash
abiHash :: Verbosity
-> PackageDescription
-> SymbolicPath Pkg ('Dir Dist)
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO AbiHash
abiHash Verbosity
verbosity PackageDescription
pkg SymbolicPath Pkg ('Dir Dist)
distPref LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> do
      (FilePath -> AbiHash) -> IO FilePath -> IO AbiHash
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> AbiHash
mkAbiHash (IO FilePath -> IO AbiHash) -> IO FilePath -> IO AbiHash
forall a b. (a -> b) -> a -> b
$ Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
GHC.libAbiHash Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi' Library
lib ComponentLocalBuildInfo
clbi
    CompilerFlavor
GHCJS -> do
      (FilePath -> AbiHash) -> IO FilePath -> IO AbiHash
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> AbiHash
mkAbiHash (IO FilePath -> IO AbiHash) -> IO FilePath -> IO AbiHash
forall a b. (a -> b) -> a -> b
$ Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO FilePath
GHCJS.libAbiHash Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi' Library
lib ComponentLocalBuildInfo
clbi
    CompilerFlavor
_ -> AbiHash -> IO AbiHash
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> AbiHash
mkAbiHash FilePath
"")
  where
    comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    lbi' :: LocalBuildInfo
lbi' =
      LocalBuildInfo
lbi
        { withPackageDB =
            withPackageDB lbi
              ++ [SpecificPackageDB (internalPackageDBPath lbi distPref)]
        }

relocRegistrationInfo
  :: Verbosity
  -> PackageDescription
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> AbiHash
  -> PackageDB
  -> IO InstalledPackageInfo
relocRegistrationInfo :: Verbosity
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> AbiHash
-> PackageDB
-> IO InstalledPackageInfo
relocRegistrationInfo Verbosity
verbosity PackageDescription
pkg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi AbiHash
abi_hash PackageDB
packageDb =
  case (Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)) of
    CompilerFlavor
GHC -> do
      fs <- Verbosity
-> LocalBuildInfo -> PackageDB -> IO (SymbolicPath CWD ('Dir Pkg))
GHC.pkgRoot Verbosity
verbosity LocalBuildInfo
lbi PackageDB
packageDb
      return
        ( relocatableInstalledPackageInfo
            pkg
            abi_hash
            lib
            lbi
            clbi
            fs
        )
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO InstalledPackageInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
RelocRegistrationInfo

initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO ()
initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO ()
initPackageDB Verbosity
verbosity Compiler
comp ProgramDb
progdb FilePath
dbPath =
  Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO ()
createPackageDB Verbosity
verbosity Compiler
comp ProgramDb
progdb Bool
False FilePath
dbPath

-- | Create an empty package DB at the specified location.
createPackageDB
  :: Verbosity
  -> Compiler
  -> ProgramDb
  -> Bool
  -> FilePath
  -> IO ()
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool -> FilePath -> IO ()
createPackageDB Verbosity
verbosity Compiler
comp ProgramDb
progdb Bool
preferCompat FilePath
dbPath =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
HcPkg.init (ProgramDb -> HcPkgInfo
GHC.hcPkgInfo ProgramDb
progdb) Verbosity
verbosity Bool
preferCompat FilePath
dbPath
    CompilerFlavor
GHCJS -> HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
HcPkg.init (ProgramDb -> HcPkgInfo
GHCJS.hcPkgInfo ProgramDb
progdb) Verbosity
verbosity Bool
False FilePath
dbPath
    CompilerFlavor
UHC -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HaskellSuite FilePath
_ -> Verbosity -> ProgramDb -> FilePath -> IO ()
HaskellSuite.initPackageDB Verbosity
verbosity ProgramDb
progdb FilePath
dbPath
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
CreatePackageDB

doesPackageDBExist :: FilePath -> IO Bool
doesPackageDBExist :: FilePath -> IO Bool
doesPackageDBExist FilePath
dbPath = do
  -- currently one impl for all compiler flavours, but could change if needed
  dir_exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dbPath
  if dir_exists
    then return True
    else doesFileExist dbPath

deletePackageDB :: FilePath -> IO ()
deletePackageDB :: FilePath -> IO ()
deletePackageDB FilePath
dbPath = do
  -- currently one impl for all compiler flavours, but could change if needed
  dir_exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dbPath
  if dir_exists
    then removeDirectoryRecursive dbPath
    else do
      file_exists <- doesFileExist dbPath
      when file_exists $ removeFile dbPath

-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
invokeHcPkg
  :: Verbosity
  -> Compiler
  -> ProgramDb
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> PackageDBStack
  -> [String]
  -> IO ()
invokeHcPkg :: Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> [FilePath]
-> IO ()
invokeHcPkg Verbosity
verbosity Compiler
comp ProgramDb
progdb Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBStack
dbStack [FilePath]
extraArgs =
  Verbosity
-> FilePath
-> Compiler
-> ProgramDb
-> (HcPkgInfo -> IO ())
-> IO ()
forall a.
Verbosity
-> FilePath -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg
    Verbosity
verbosity
    FilePath
"invokeHcPkg"
    Compiler
comp
    ProgramDb
progdb
    (\HcPkgInfo
hpi -> HcPkgInfo
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> [FilePath]
-> IO ()
HcPkg.invoke HcPkgInfo
hpi Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBStack
dbStack [FilePath]
extraArgs)

withHcPkg
  :: Verbosity
  -> String
  -> Compiler
  -> ProgramDb
  -> (HcPkg.HcPkgInfo -> IO a)
  -> IO a
withHcPkg :: forall a.
Verbosity
-> FilePath -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg Verbosity
verbosity FilePath
name Compiler
comp ProgramDb
progdb HcPkgInfo -> IO a
f =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> HcPkgInfo -> IO a
f (ProgramDb -> HcPkgInfo
GHC.hcPkgInfo ProgramDb
progdb)
    CompilerFlavor
GHCJS -> HcPkgInfo -> IO a
f (ProgramDb -> HcPkgInfo
GHCJS.hcPkgInfo ProgramDb
progdb)
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO a) -> CabalException -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
WithHcPkg FilePath
name

registerPackage
  :: Verbosity
  -> Compiler
  -> ProgramDb
  -> Maybe (SymbolicPath CWD (Dir from))
  -> PackageDBStackS from
  -> InstalledPackageInfo
  -> HcPkg.RegisterOptions
  -> IO ()
registerPackage :: forall from.
Verbosity
-> Compiler
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity Compiler
comp ProgramDb
progdb Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackS from
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> Verbosity
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
forall from.
Verbosity
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
GHC.registerPackage Verbosity
verbosity ProgramDb
progdb Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackS from
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
    CompilerFlavor
GHCJS -> Verbosity
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
forall from.
Verbosity
-> ProgramDb
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
GHCJS.registerPackage Verbosity
verbosity ProgramDb
progdb Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackS from
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
    HaskellSuite{} ->
      Verbosity
-> ProgramDb
-> PackageDBStackS from
-> InstalledPackageInfo
-> IO ()
forall from.
Verbosity
-> ProgramDb
-> PackageDBStackS from
-> InstalledPackageInfo
-> IO ()
HaskellSuite.registerPackage Verbosity
verbosity ProgramDb
progdb PackageDBStackS from
packageDbs InstalledPackageInfo
installedPkgInfo
    CompilerFlavor
_
      | RegisterOptions -> Bool
HcPkg.registerMultiInstance RegisterOptions
registerOptions ->
          Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
RegisMultiplePkgNotSupported
    CompilerFlavor
UHC -> Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> Compiler
-> ProgramDb
-> PackageDBStackS from
-> InstalledPackageInfo
-> IO ()
forall from.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> Compiler
-> ProgramDb
-> PackageDBStackS from
-> InstalledPackageInfo
-> IO ()
UHC.registerPackage Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir Compiler
comp ProgramDb
progdb PackageDBStackS from
packageDbs InstalledPackageInfo
installedPkgInfo
    CompilerFlavor
_ -> Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
RegisteringNotImplemented

writeHcPkgRegisterScript
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> [InstalledPackageInfo]
  -> PackageDBStack
  -> HcPkg.HcPkgInfo
  -> IO ()
writeHcPkgRegisterScript :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [InstalledPackageInfo]
-> PackageDBStack
-> HcPkgInfo
-> IO ()
writeHcPkgRegisterScript Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [InstalledPackageInfo]
ipis PackageDBStack
packageDbs HcPkgInfo
hpi = do
  let genScript :: InstalledPackageInfo -> FilePath
genScript InstalledPackageInfo
installedPkgInfo =
        let invocation :: ProgramInvocation
invocation =
              HcPkgInfo
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
forall from.
HcPkgInfo
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
HcPkg.registerInvocation
                HcPkgInfo
hpi
                Verbosity
Verbosity.normal
                Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
                PackageDBStack
packageDbs
                InstalledPackageInfo
installedPkgInfo
                RegisterOptions
HcPkg.defaultRegisterOptions
         in OS -> ProgramInvocation -> FilePath
invocationAsSystemScript OS
buildOS ProgramInvocation
invocation
      scripts :: [FilePath]
scripts = (InstalledPackageInfo -> FilePath)
-> [InstalledPackageInfo] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> FilePath
genScript [InstalledPackageInfo]
ipis
      -- TODO: Do something more robust here
      regScript :: FilePath
regScript = [FilePath] -> FilePath
unlines [FilePath]
scripts

  let out_file :: FilePath
out_file = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg 'File
regScriptFileName
  Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath
"Creating package registration script: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
out_file)
  FilePath -> FilePath -> IO ()
writeUTF8File FilePath
out_file FilePath
regScript
  FilePath -> IO ()
setFileExecutable FilePath
out_file

regScriptFileName :: SymbolicPath Pkg File
regScriptFileName :: SymbolicPathX 'AllowAbsolute Pkg 'File
regScriptFileName = case OS
buildOS of
  OS
Windows -> FilePath -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir). FilePath -> SymbolicPath from to
makeSymbolicPath FilePath
"register.bat"
  OS
_ -> FilePath -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir). FilePath -> SymbolicPath from to
makeSymbolicPath FilePath
"register.sh"

-- -----------------------------------------------------------------------------
-- Making the InstalledPackageInfo

-- | Construct 'InstalledPackageInfo' for a library in a package, given a set
-- of installation directories.
generalInstalledPackageInfo
  :: ([FilePath] -> [FilePath])
  -- ^ Translate relative include dir paths to
  -- absolute paths.
  -> PackageDescription
  -> AbiHash
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> InstallDirs FilePath
  -> InstalledPackageInfo
generalInstalledPackageInfo :: ([FilePath] -> [FilePath])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs FilePath
-> InstalledPackageInfo
generalInstalledPackageInfo [FilePath] -> [FilePath]
adjustRelIncDirs PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi InstallDirs FilePath
installDirs =
  IPI.InstalledPackageInfo
    { sourcePackageId :: PackageIdentifier
IPI.sourcePackageId = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
    , installedUnitId :: UnitId
IPI.installedUnitId = ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi
    , installedComponentId_ :: ComponentId
IPI.installedComponentId_ = ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi
    , instantiatedWith :: [(ModuleName, OpenModule)]
IPI.instantiatedWith = ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith ComponentLocalBuildInfo
clbi
    , sourceLibName :: LibraryName
IPI.sourceLibName = Library -> LibraryName
libName Library
lib
    , compatPackageKey :: FilePath
IPI.compatPackageKey = ComponentLocalBuildInfo -> FilePath
componentCompatPackageKey ComponentLocalBuildInfo
clbi
    , -- If GHC >= 8.4 we register with SDPX, otherwise with legacy license
      license :: Either License License
IPI.license =
        if Bool
ghc84
          then License -> Either License License
forall a b. a -> Either a b
Left (License -> Either License License)
-> License -> Either License License
forall a b. (a -> b) -> a -> b
$ (License -> License)
-> (License -> License) -> Either License License -> License
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
forall a. a -> a
id License -> License
licenseToSPDX (Either License License -> License)
-> Either License License -> License
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
          else License -> Either License License
forall a b. b -> Either a b
Right (License -> Either License License)
-> License -> Either License License
forall a b. (a -> b) -> a -> b
$ (License -> License)
-> (License -> License) -> Either License License -> License
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
licenseFromSPDX License -> License
forall a. a -> a
id (Either License License -> License)
-> Either License License -> License
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
    , copyright :: ShortText
IPI.copyright = PackageDescription -> ShortText
copyright PackageDescription
pkg
    , maintainer :: ShortText
IPI.maintainer = PackageDescription -> ShortText
maintainer PackageDescription
pkg
    , author :: ShortText
IPI.author = PackageDescription -> ShortText
author PackageDescription
pkg
    , stability :: ShortText
IPI.stability = PackageDescription -> ShortText
stability PackageDescription
pkg
    , homepage :: ShortText
IPI.homepage = PackageDescription -> ShortText
homepage PackageDescription
pkg
    , pkgUrl :: ShortText
IPI.pkgUrl = PackageDescription -> ShortText
pkgUrl PackageDescription
pkg
    , synopsis :: ShortText
IPI.synopsis = PackageDescription -> ShortText
synopsis PackageDescription
pkg
    , description :: ShortText
IPI.description = PackageDescription -> ShortText
description PackageDescription
pkg
    , category :: ShortText
IPI.category = PackageDescription -> ShortText
category PackageDescription
pkg
    , abiHash :: AbiHash
IPI.abiHash = AbiHash
abi_hash
    , indefinite :: Bool
IPI.indefinite = ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi
    , exposed :: Bool
IPI.exposed = Library -> Bool
libExposed Library
lib
    , exposedModules :: [ExposedModule]
IPI.exposedModules =
        ComponentLocalBuildInfo -> [ExposedModule]
componentExposedModules ComponentLocalBuildInfo
clbi
          -- add virtual modules into the list of exposed modules for the
          -- package database as well.
          [ExposedModule] -> [ExposedModule] -> [ExposedModule]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> ExposedModule) -> [ModuleName] -> [ExposedModule]
forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
name -> ModuleName -> Maybe OpenModule -> ExposedModule
IPI.ExposedModule ModuleName
name Maybe OpenModule
forall a. Maybe a
Nothing) (BuildInfo -> [ModuleName]
virtualModules BuildInfo
bi)
    , hiddenModules :: [ModuleName]
IPI.hiddenModules = BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
    , trusted :: Bool
IPI.trusted = InstalledPackageInfo -> Bool
IPI.trusted InstalledPackageInfo
IPI.emptyInstalledPackageInfo
    , importDirs :: [FilePath]
IPI.importDirs = [InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir InstallDirs FilePath
installDirs | Bool
hasModules]
    , libraryDirs :: [FilePath]
IPI.libraryDirs = [FilePath]
libdirs
    , libraryDirsStatic :: [FilePath]
IPI.libraryDirsStatic = [FilePath]
libdirsStatic
    , libraryDynDirs :: [FilePath]
IPI.libraryDynDirs = [FilePath]
dynlibdirs
    , dataDir :: FilePath
IPI.dataDir = InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
datadir InstallDirs FilePath
installDirs
    , hsLibraries :: [FilePath]
IPI.hsLibraries =
        ( if Bool
hasLibrary
            then [UnitId -> FilePath
getHSLibraryName (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)]
            else []
        )
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
extraBundledLibs BuildInfo
bi
    , extraLibraries :: [FilePath]
IPI.extraLibraries = BuildInfo -> [FilePath]
extraLibs BuildInfo
bi
    , extraLibrariesStatic :: [FilePath]
IPI.extraLibrariesStatic = BuildInfo -> [FilePath]
extraLibsStatic BuildInfo
bi
    , extraGHCiLibraries :: [FilePath]
IPI.extraGHCiLibraries = BuildInfo -> [FilePath]
extraGHCiLibs BuildInfo
bi
    , includeDirs :: [FilePath]
IPI.includeDirs = [FilePath]
absinc [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> [FilePath]
adjustRelIncDirs [FilePath]
relinc
    , includes :: [FilePath]
IPI.includes = (SymbolicPath Include 'File -> FilePath)
-> [SymbolicPath Include 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Include 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPath Include 'File] -> [FilePath])
-> [SymbolicPath Include 'File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath Include 'File]
includes BuildInfo
bi
    , depends :: [UnitId]
IPI.depends = [UnitId]
depends
    , abiDepends :: [AbiDependency]
IPI.abiDepends = [] -- due to #5465
    , ccOptions :: [FilePath]
IPI.ccOptions = [] -- Note. NOT ccOptions bi!
    -- We don't want cc-options to be propagated
    -- to C compilations in other packages.
    , cxxOptions :: [FilePath]
IPI.cxxOptions = [] -- Also. NOT cxxOptions bi!
    , ldOptions :: [FilePath]
IPI.ldOptions = BuildInfo -> [FilePath]
ldOptions BuildInfo
bi
    , frameworks :: [FilePath]
IPI.frameworks = (RelativePath Framework 'File -> FilePath)
-> [RelativePath Framework 'File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RelativePath Framework 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([RelativePath Framework 'File] -> [FilePath])
-> [RelativePath Framework 'File] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [RelativePath Framework 'File]
frameworks BuildInfo
bi
    , frameworkDirs :: [FilePath]
IPI.frameworkDirs = (SymbolicPath Pkg ('Dir Framework) -> FilePath)
-> [SymbolicPath Pkg ('Dir Framework)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Framework) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPath Pkg ('Dir Framework)] -> [FilePath])
-> [SymbolicPath Pkg ('Dir Framework)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath Pkg ('Dir Framework)]
extraFrameworkDirs BuildInfo
bi
    , haddockInterfaces :: [FilePath]
IPI.haddockInterfaces = [InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
haddockdir InstallDirs FilePath
installDirs FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> PackageDescription -> Library -> FilePath
haddockLibraryPath PackageDescription
pkg Library
lib]
    , haddockHTMLs :: [FilePath]
IPI.haddockHTMLs = [InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
htmldir InstallDirs FilePath
installDirs]
    , pkgRoot :: Maybe FilePath
IPI.pkgRoot = Maybe FilePath
forall a. Maybe a
Nothing
    , libVisibility :: LibraryVisibility
IPI.libVisibility = Library -> LibraryVisibility
libVisibility Library
lib
    }
  where
    ghc84 :: Bool
ghc84 = case Compiler -> CompilerId
compilerId (Compiler -> CompilerId) -> Compiler -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
      CompilerId CompilerFlavor
GHC Version
v -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
4]
      CompilerId
_ -> Bool
False

    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
    -- TODO: unclear what the root cause of the
    -- duplication is, but we nub it here for now:
    depends :: [UnitId]
depends = [UnitId] -> [UnitId]
forall a. Ord a => [a] -> [a]
ordNub ([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
forall a b. (a -> b) -> a -> b
$ ((UnitId, MungedPackageId) -> UnitId)
-> [(UnitId, MungedPackageId)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, MungedPackageId) -> UnitId
forall a b. (a, b) -> a
fst (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)
    ([FilePath]
absinc, [FilePath]
relinc) = (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition FilePath -> Bool
isAbsolute ((SymbolicPath Pkg ('Dir Include) -> FilePath)
-> [SymbolicPath Pkg ('Dir Include)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Include) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPath Pkg ('Dir Include)] -> [FilePath])
-> [SymbolicPath Pkg ('Dir Include)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath Pkg ('Dir Include)]
includeDirs BuildInfo
bi)
    hasModules :: Bool
hasModules = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)
    comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    hasLibrary :: Bool
hasLibrary =
      ( Bool
hasModules
          Bool -> Bool -> Bool
|| Bool -> Bool
not ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cSources BuildInfo
bi))
          Bool -> Bool -> Bool
|| Bool -> Bool
not ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
asmSources BuildInfo
bi))
          Bool -> Bool -> Bool
|| Bool -> Bool
not ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cmmSources BuildInfo
bi))
          Bool -> Bool -> Bool
|| Bool -> Bool
not ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
cxxSources BuildInfo
bi))
          Bool -> Bool -> Bool
|| (Bool -> Bool
not ([SymbolicPathX 'AllowAbsolute Pkg 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg 'File]
jsSources BuildInfo
bi)) Bool -> Bool -> Bool
&& Bool
hasJsSupport)
      )
        Bool -> Bool -> Bool
&& Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
    hasJsSupport :: Bool
hasJsSupport = case LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi of
      Platform Arch
JavaScript OS
_ -> Bool
True
      Platform
_ -> Bool
False
    extraLibDirs' :: [FilePath]
extraLibDirs' = (SymbolicPath Pkg ('Dir Lib) -> FilePath)
-> [SymbolicPath Pkg ('Dir Lib)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Lib) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath ([SymbolicPath Pkg ('Dir Lib)] -> [FilePath])
-> [SymbolicPath Pkg ('Dir Lib)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirs BuildInfo
bi
    libdirsStatic :: [FilePath]
libdirsStatic
      | Bool
hasLibrary = InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir InstallDirs FilePath
installDirs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
extraLibDirsStaticOrFallback
      | Bool
otherwise = [FilePath]
extraLibDirsStaticOrFallback
      where
        -- If no static library dirs were given, the package likely makes no
        -- distinction between fully static linking and otherwise.
        -- Fall back to the normal library dirs in that case.
        extraLibDirsStaticOrFallback :: [FilePath]
extraLibDirsStaticOrFallback = case BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirsStatic BuildInfo
bi of
          [] -> [FilePath]
extraLibDirs'
          [SymbolicPath Pkg ('Dir Lib)]
dirs -> (SymbolicPath Pkg ('Dir Lib) -> FilePath)
-> [SymbolicPath Pkg ('Dir Lib)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath Pkg ('Dir Lib) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath [SymbolicPath Pkg ('Dir Lib)]
dirs
    ([FilePath]
libdirs, [FilePath]
dynlibdirs)
      | Bool -> Bool
not Bool
hasLibrary =
          ([FilePath]
extraLibDirs', [])
      -- the dynamic-library-dirs defaults to the library-dirs if not specified,
      -- so this works whether the dynamic-library-dirs field is supported or not

      | Compiler -> Bool
libraryDynDirSupported Compiler
comp =
          ( InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir InstallDirs FilePath
installDirs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
extraLibDirs'
          , InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs FilePath
installDirs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
extraLibDirs'
          )
      | Bool
otherwise =
          (InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir InstallDirs FilePath
installDirs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs FilePath
installDirs FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
extraLibDirs', [])

-- the compiler doesn't understand the dynamic-library-dirs field so we
-- add the dyn directory to the "normal" list in the library-dirs field

-- | Construct 'InstalledPackageInfo' for a library that is in place in the
-- build tree.
--
-- This function knows about the layout of in place packages.
inplaceInstalledPackageInfo
  :: AbsolutePath (Dir Pkg)
  -> SymbolicPath Pkg (Dir Dist)
  -- ^ location of the dist tree
  -> PackageDescription
  -> AbiHash
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> InstalledPackageInfo
inplaceInstalledPackageInfo :: AbsolutePath ('Dir Pkg)
-> SymbolicPath Pkg ('Dir Dist)
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo AbsolutePath ('Dir Pkg)
inplaceDir SymbolicPath Pkg ('Dir Dist)
distPref PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  ([FilePath] -> [FilePath])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs FilePath
-> InstalledPackageInfo
generalInstalledPackageInfo
    [FilePath] -> [FilePath]
adjustRelativeIncludeDirs
    PackageDescription
pkg
    AbiHash
abi_hash
    Library
lib
    LocalBuildInfo
lbi
    ComponentLocalBuildInfo
clbi
    InstallDirs FilePath
installDirs
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> FilePath
i = AbsolutePath ('Dir Pkg)
-> SymbolicPathX allowAbsolute Pkg to -> FilePath
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
AbsolutePath ('Dir Pkg)
-> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathAbsolute AbsolutePath ('Dir Pkg)
inplaceDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    adjustRelativeIncludeDirs :: [FilePath] -> [FilePath]
adjustRelativeIncludeDirs = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((FilePath -> [FilePath]) -> [FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
d ->
      [ SymbolicPathX 'OnlyRelative Pkg (ZonkAny 1) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (SymbolicPathX 'OnlyRelative Pkg (ZonkAny 1) -> FilePath)
-> SymbolicPathX 'OnlyRelative Pkg (ZonkAny 1) -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> SymbolicPathX 'OnlyRelative Pkg (ZonkAny 1)
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
d -- local include-dir
      , SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0) -> FilePath
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Build)
libTargetDir SymbolicPath Pkg ('Dir Build)
-> RelativePath Build (ZonkAny 0)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 0)
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Build (ZonkAny 0)
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
d -- autogen include-dir
      ]
    libTargetDir :: SymbolicPath Pkg ('Dir Build)
libTargetDir = LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    installDirs :: InstallDirs FilePath
installDirs =
      (PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest)
        { libdir = i libTargetDir
        , dynlibdir = i libTargetDir
        , datadir =
            let rawDataDir = PackageDescription -> SymbolicPath Pkg ('Dir DataDir)
dataDir PackageDescription
pkg
             in if null $ getSymbolicPath rawDataDir
                  then i sameDirectory
                  else i rawDataDir
        , docdir = i inplaceDocdir
        , htmldir = inplaceHtmldir
        , haddockdir = inplaceHtmldir
        }
    inplaceDocdir :: SymbolicPathX 'AllowAbsolute Pkg c3
inplaceDocdir = SymbolicPath Pkg ('Dir Dist)
distPref SymbolicPath Pkg ('Dir Dist)
-> RelativePath Dist c3 -> SymbolicPathX 'AllowAbsolute Pkg c3
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Dist c3
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
"doc"
    inplaceHtmldir :: FilePath
inplaceHtmldir = SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> FilePath
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> FilePath
i (SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> FilePath)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3) -> FilePath
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'AllowAbsolute Pkg ('Dir (ZonkAny 2))
forall {c3 :: FileOrDir}. SymbolicPathX 'AllowAbsolute Pkg c3
inplaceDocdir SymbolicPathX 'AllowAbsolute Pkg ('Dir (ZonkAny 2))
-> RelativePath (ZonkAny 2) (ZonkAny 3)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 3)
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath (ZonkAny 2) (ZonkAny 3)
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx (FilePath
"html" FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</> PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg))

-- | Construct 'InstalledPackageInfo' for the final install location of a
-- library package.
--
-- This function knows about the layout of installed packages.
absoluteInstalledPackageInfo
  :: PackageDescription
  -> AbiHash
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> InstalledPackageInfo
absoluteInstalledPackageInfo :: PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
absoluteInstalledPackageInfo PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  ([FilePath] -> [FilePath])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs FilePath
-> InstalledPackageInfo
generalInstalledPackageInfo
    [FilePath] -> [FilePath]
forall {p}. p -> [FilePath]
adjustReativeIncludeDirs
    PackageDescription
pkg
    AbiHash
abi_hash
    Library
lib
    LocalBuildInfo
lbi
    ComponentLocalBuildInfo
clbi
    InstallDirs FilePath
installDirs
  where
    -- For installed packages we install all include files into one dir,
    -- whereas in the build tree they may live in multiple local dirs.
    adjustReativeIncludeDirs :: p -> [FilePath]
adjustReativeIncludeDirs p
_
      | [RelativePath Include 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [RelativePath Include 'File]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise = [InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
includedir InstallDirs FilePath
installDirs]
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
    installDirs :: InstallDirs FilePath
installDirs = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest

relocatableInstalledPackageInfo
  :: PackageDescription
  -> AbiHash
  -> Library
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -> SymbolicPath CWD ('Dir Pkg)
  -> InstalledPackageInfo
relocatableInstalledPackageInfo :: PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPath CWD ('Dir Pkg)
-> InstalledPackageInfo
relocatableInstalledPackageInfo PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi SymbolicPath CWD ('Dir Pkg)
pkgroot =
  ([FilePath] -> [FilePath])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs FilePath
-> InstalledPackageInfo
generalInstalledPackageInfo
    [FilePath] -> [FilePath]
forall {p}. p -> [FilePath]
adjustReativeIncludeDirs
    PackageDescription
pkg
    AbiHash
abi_hash
    Library
lib
    LocalBuildInfo
lbi
    ComponentLocalBuildInfo
clbi
    InstallDirs FilePath
installDirs
  where
    -- For installed packages we install all include files into one dir,
    -- whereas in the build tree they may live in multiple local dirs.
    adjustReativeIncludeDirs :: p -> [FilePath]
adjustReativeIncludeDirs p
_
      | [RelativePath Include 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [RelativePath Include 'File]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise = [InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
includedir InstallDirs FilePath
installDirs]
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib

    installDirs :: InstallDirs FilePath
installDirs =
      (FilePath -> FilePath)
-> InstallDirs FilePath -> InstallDirs FilePath
forall a b. (a -> b) -> InstallDirs a -> InstallDirs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath
"${pkgroot}" FilePath -> FilePath -> FilePath
forall p q r. PathLike p q r => p -> q -> r
</>) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
shortRelativePath (SymbolicPath CWD ('Dir Pkg) -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath CWD ('Dir Pkg)
pkgroot)) (InstallDirs FilePath -> InstallDirs FilePath)
-> InstallDirs FilePath -> InstallDirs FilePath
forall a b. (a -> b) -> a -> b
$
        PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs FilePath
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest

-- -----------------------------------------------------------------------------
-- Unregistration

unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister PackageDescription
pkg LocalBuildInfo
lbi RegisterFlags
regFlags = do
  let pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
      common :: CommonSetupFlags
common = RegisterFlags -> CommonSetupFlags
registerCommonFlags RegisterFlags
regFlags
      genScript :: Bool
genScript = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Bool
regGenScript RegisterFlags
regFlags)
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common)
      packageDb :: PackageDB
packageDb =
        PackageDB -> Flag PackageDB -> PackageDB
forall a. a -> Flag a -> a
fromFlagOrDefault
          (PackageDBStack -> PackageDB
forall from. PackageDBStackX from -> PackageDBX from
registrationPackageDB (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi))
          (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags)
      mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
      unreg :: HcPkgInfo -> IO ()
unreg HcPkgInfo
hpi =
        let invocation :: ProgramInvocation
invocation =
              HcPkgInfo
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDB
-> PackageIdentifier
-> ProgramInvocation
HcPkg.unregisterInvocation
                HcPkgInfo
hpi
                Verbosity
Verbosity.normal
                Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
                PackageDB
packageDb
                PackageIdentifier
pkgid
         in if Bool
genScript
              then
                FilePath -> ByteString -> IO ()
writeFileAtomic
                  FilePath
unregScriptFileName
                  (FilePath -> ByteString
BS.Char8.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ OS -> ProgramInvocation -> FilePath
invocationAsSystemScript OS
buildOS ProgramInvocation
invocation)
              else Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
invocation
  Verbosity -> FilePath -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity FilePath
"Unregistering" PackageIdentifier
pkgid
  Verbosity
-> FilePath
-> Compiler
-> ProgramDb
-> (HcPkgInfo -> IO ())
-> IO ()
forall a.
Verbosity
-> FilePath -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg
    Verbosity
verbosity
    FilePath
"unregistering is only implemented for GHC and GHCJS"
    (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
    (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
    HcPkgInfo -> IO ()
unreg

unregScriptFileName :: FilePath
unregScriptFileName :: FilePath
unregScriptFileName = case OS
buildOS of
  OS
Windows -> FilePath
"unregister.bat"
  OS
_ -> FilePath
"unregister.sh"

internalPackageDBPath :: LocalBuildInfo -> SymbolicPath Pkg (Dir Dist) -> SymbolicPath Pkg (Dir PkgDB)
internalPackageDBPath :: LocalBuildInfo
-> SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg ('Dir PkgDB)
internalPackageDBPath LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Dist)
distPref =
  case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
    CompilerFlavor
UHC -> LocalBuildInfo -> SymbolicPath Pkg ('Dir PkgDB)
UHC.inplacePackageDbPath LocalBuildInfo
lbi
    CompilerFlavor
_ -> SymbolicPath Pkg ('Dir Dist)
distPref SymbolicPath Pkg ('Dir Dist)
-> RelativePath Dist ('Dir PkgDB) -> SymbolicPath Pkg ('Dir PkgDB)
forall p q r. PathLike p q r => p -> q -> r
</> FilePath -> RelativePath Dist ('Dir PkgDB)
forall from (to :: FileOrDir).
HasCallStack =>
FilePath -> RelativePath from to
makeRelativePathEx FilePath
"package.conf.inplace"