{-# 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 Prelude ()
import Distribution.Compat.Prelude

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

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

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

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

import System.FilePath ((</>), (<.>), isAbsolute)
import System.Directory

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 =
   -- 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.
   IO ()
doRegister
 where
  doRegister :: IO ()
doRegister = do
    [TargetInfo]
targets <- Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [String]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi0 (RegisterFlags -> [String]
regArgs RegisterFlags
flags)

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

    (InstalledPackageIndex
_, [Maybe InstalledPackageInfo]
ipi_mbs) <-
        forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM forall a b c. (a -> b -> c) -> b -> a -> c
`flip` LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi0 forall a b c. (a -> b -> c) -> b -> a -> c
`flip` [TargetInfo]
componentsToRegister forall a b. (a -> b) -> a -> b
$ \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 :: InstalledPackageIndex
installedPkgs = InstalledPackageIndex
index }
                    InstalledPackageInfo
ipi <- PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> RegisterFlags
-> IO InstalledPackageInfo
generateOne PackageDescription
pkg_descr Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi RegisterFlags
flags
                    forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
Index.insert InstalledPackageInfo
ipi InstalledPackageIndex
index, forall a. a -> Maybe a
Just InstalledPackageInfo
ipi)
                Component
_   -> forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex
index, forall a. Maybe a
Nothing)

    PackageDescription
-> LocalBuildInfo
-> RegisterFlags
-> [InstalledPackageInfo]
-> IO ()
registerAll PackageDescription
pkg_descr LocalBuildInfo
lbi0 RegisterFlags
flags (forall a. [Maybe a] -> [a]
catMaybes [Maybe InstalledPackageInfo]
ipi_mbs)
   where
    verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags)

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
    PackageDBStack
absPackageDBs    <- PackageDBStack -> IO PackageDBStack
absolutePackageDBPaths PackageDBStack
packageDbs
    InstalledPackageInfo
installedPkgInfo <- Verbosity
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Bool
-> String
-> PackageDB
-> IO InstalledPackageInfo
generateRegistrationInfo
                           Verbosity
verbosity PackageDescription
pkg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
inplace Bool
reloc String
distPref
                           (PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
absPackageDBs)
    Verbosity -> String -> IO ()
info Verbosity
verbosity (InstalledPackageInfo -> String
IPI.showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo)
    forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
installedPkgInfo
  where
    inplace :: Bool
inplace   = 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 = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
                    forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (forall a. Flag a -> Maybe a
flagToMaybe  (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags))
    distPref :: String
distPref  = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag String
regDistPref RegisterFlags
regFlags)
    verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
regFlags)

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

     -- Three different modes:
    case () of
     ()
_ | Bool
modeGenerateRegFile   -> IO ()
writeRegistrationFileOrDirectory
       | Bool
modeGenerateRegScript -> IO ()
writeRegisterScript
       | Bool
otherwise             -> do
           forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [InstalledPackageInfo]
ipis forall a b. (a -> b) -> a -> b
$ \InstalledPackageInfo
ipi -> do
               forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity String
"Registering" (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg)
                 (LibraryName -> ComponentName
CLibName (InstalledPackageInfo -> LibraryName
IPI.sourceLibName InstalledPackageInfo
ipi))
                 (forall a. a -> Maybe a
Just (InstalledPackageInfo -> [(ModuleName, OpenModule)]
IPI.instantiatedWith InstalledPackageInfo
ipi))
               Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
                               PackageDBStack
packageDbs InstalledPackageInfo
ipi RegisterOptions
HcPkg.defaultRegisterOptions

  where
    modeGenerateRegFile :: Bool
modeGenerateRegFile = forall a. Maybe a -> Bool
isJust (forall a. Flag a -> Maybe a
flagToMaybe (RegisterFlags -> Flag (Maybe String)
regGenPkgConf RegisterFlags
regFlags))
    regFile :: String
regFile             = forall a. a -> Maybe a -> a
fromMaybe (forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) String -> String -> String
<.> String
"conf")
                                    (forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag (Maybe String)
regGenPkgConf RegisterFlags
regFlags))

    modeGenerateRegScript :: Bool
modeGenerateRegScript = 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 = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
                    forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (forall a. Flag a -> Maybe a
flagToMaybe  (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags))
    verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
regFlags)

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

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


generateRegistrationInfo :: Verbosity
                         -> PackageDescription
                         -> Library
                         -> LocalBuildInfo
                         -> ComponentLocalBuildInfo
                         -> Bool
                         -> Bool
                         -> FilePath
                         -> PackageDB
                         -> IO InstalledPackageInfo
generateRegistrationInfo :: Verbosity
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Bool
-> String
-> PackageDB
-> IO InstalledPackageInfo
generateRegistrationInfo Verbosity
verbosity PackageDescription
pkg Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi Bool
inplace Bool
reloc String
distPref PackageDB
packageDb = do
  --TODO: eliminate pwd!
  String
pwd <- IO String
getCurrentDirectory

  InstalledPackageInfo
installedPkgInfo <-
    if Bool
inplace
      -- 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.
      then forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo String
pwd String
distPref
                     PackageDescription
pkg (String -> AbiHash
mkAbiHash String
"inplace") Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)
    else do
        AbiHash
abi_hash <- Verbosity
-> PackageDescription
-> String
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO AbiHash
abiHash Verbosity
verbosity PackageDescription
pkg String
distPref LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi
        if Bool
reloc
          then 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
          else forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
absoluteInstalledPackageInfo
                         PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi)


  forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
installedPkgInfo

-- | Compute the 'AbiHash' of a library that we built inplace.
abiHash :: Verbosity
        -> PackageDescription
        -> FilePath
        -> LocalBuildInfo
        -> Library
        -> ComponentLocalBuildInfo
        -> IO AbiHash
abiHash :: Verbosity
-> PackageDescription
-> String
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO AbiHash
abiHash Verbosity
verbosity PackageDescription
pkg String
distPref LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi =
    case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
     CompilerFlavor
GHC -> do
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AbiHash
mkAbiHash forall a b. (a -> b) -> a -> b
$ Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO String
GHC.libAbiHash Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi' Library
lib ComponentLocalBuildInfo
clbi
     CompilerFlavor
GHCJS -> do
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AbiHash
mkAbiHash forall a b. (a -> b) -> a -> b
$ Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO String
GHCJS.libAbiHash Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi' Library
lib ComponentLocalBuildInfo
clbi
     CompilerFlavor
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> AbiHash
mkAbiHash String
"")
  where
    comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi
    lbi' :: LocalBuildInfo
lbi' = LocalBuildInfo
lbi {
              withPackageDB :: PackageDBStack
withPackageDB = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
                  forall a. [a] -> [a] -> [a]
++ [String -> PackageDB
SpecificPackageDB (LocalBuildInfo -> String -> String
internalPackageDBPath LocalBuildInfo
lbi String
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 String
fs <- Verbosity -> LocalBuildInfo -> PackageDB -> IO String
GHC.pkgRoot Verbosity
verbosity LocalBuildInfo
lbi PackageDB
packageDb
              forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> InstalledPackageInfo
relocatableInstalledPackageInfo
                        PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String
fs)
    CompilerFlavor
_   -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity
              String
"Distribution.Simple.Register.relocRegistrationInfo: \
               \not implemented for this compiler"

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

-- | Create an empty package DB at the specified location.
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool
                -> FilePath -> IO ()
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool -> String -> IO ()
createPackageDB Verbosity
verbosity Compiler
comp ProgramDb
progdb Bool
preferCompat String
dbPath =
    case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
      CompilerFlavor
GHC   -> HcPkgInfo -> Verbosity -> Bool -> String -> IO ()
HcPkg.init (ProgramDb -> HcPkgInfo
GHC.hcPkgInfo   ProgramDb
progdb) Verbosity
verbosity Bool
preferCompat String
dbPath
      CompilerFlavor
GHCJS -> HcPkgInfo -> Verbosity -> Bool -> String -> IO ()
HcPkg.init (ProgramDb -> HcPkgInfo
GHCJS.hcPkgInfo ProgramDb
progdb) Verbosity
verbosity Bool
False String
dbPath
      CompilerFlavor
UHC   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HaskellSuite String
_ -> Verbosity -> ProgramDb -> String -> IO ()
HaskellSuite.initPackageDB Verbosity
verbosity ProgramDb
progdb String
dbPath
      CompilerFlavor
_              -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
                              String
"Distribution.Simple.Register.createPackageDB: "
                           forall a. [a] -> [a] -> [a]
++ String
"not implemented for this compiler"

doesPackageDBExist :: FilePath -> IO Bool
doesPackageDBExist :: String -> IO Bool
doesPackageDBExist String
dbPath = do
    -- currently one impl for all compiler flavours, but could change if needed
    Bool
dir_exists <- String -> IO Bool
doesDirectoryExist String
dbPath
    if Bool
dir_exists
        then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else String -> IO Bool
doesFileExist String
dbPath

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

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

withHcPkg :: Verbosity -> String -> Compiler -> ProgramDb
          -> (HcPkg.HcPkgInfo -> IO a) -> IO a
withHcPkg :: forall a.
Verbosity
-> String -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg Verbosity
verbosity String
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
_     -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String
"Distribution.Simple.Register." forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
":\
                  \not implemented for this compiler")

registerPackage :: Verbosity
                -> Compiler
                -> ProgramDb
                -> PackageDBStack
                -> InstalledPackageInfo
                -> HcPkg.RegisterOptions
                -> IO ()
registerPackage :: Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
registerPackage Verbosity
verbosity Compiler
comp ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC   -> Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
GHC.registerPackage   Verbosity
verbosity ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
    CompilerFlavor
GHCJS -> Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
GHCJS.registerPackage Verbosity
verbosity ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo RegisterOptions
registerOptions
    HaskellSuite {} ->
      Verbosity
-> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> IO ()
HaskellSuite.registerPackage Verbosity
verbosity      ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo
    CompilerFlavor
_ | RegisterOptions -> Bool
HcPkg.registerMultiInstance RegisterOptions
registerOptions
          -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Registering multiple package instances is not yet supported for this compiler"
    CompilerFlavor
UHC   -> Verbosity
-> Compiler
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> IO ()
UHC.registerPackage   Verbosity
verbosity Compiler
comp ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo
    CompilerFlavor
_    -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
"Registering is not implemented for this compiler"

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

  Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"Creating package registration script: " forall a. [a] -> [a] -> [a]
++ String
regScriptFileName)
  String -> String -> IO ()
writeUTF8File String
regScriptFileName String
regScript
  String -> IO ()
setFileExecutable String
regScriptFileName

regScriptFileName :: FilePath
regScriptFileName :: String
regScriptFileName = case OS
buildOS of
                        OS
Windows -> String
"register.bat"
                        OS
_       -> String
"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 :: ([String] -> [String])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs String
-> InstalledPackageInfo
generalInstalledPackageInfo [String] -> [String]
adjustRelIncDirs PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi InstallDirs String
installDirs =
  IPI.InstalledPackageInfo {
    sourcePackageId :: PackageIdentifier
IPI.sourcePackageId    = 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 :: String
IPI.compatPackageKey   = ComponentLocalBuildInfo -> String
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 forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id License -> License
licenseToSPDX forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
        else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
licenseFromSPDX forall a. a -> a
id 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.
                             forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
name -> ModuleName -> Maybe OpenModule -> ExposedModule
IPI.ExposedModule ModuleName
name 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 :: [String]
IPI.importDirs         = [ forall dir. InstallDirs dir -> dir
libdir InstallDirs String
installDirs | Bool
hasModules ],
    libraryDirs :: [String]
IPI.libraryDirs        = [String]
libdirs,
    libraryDynDirs :: [String]
IPI.libraryDynDirs     = [String]
dynlibdirs,
    dataDir :: String
IPI.dataDir            = forall dir. InstallDirs dir -> dir
datadir InstallDirs String
installDirs,
    hsLibraries :: [String]
IPI.hsLibraries        = (if Bool
hasLibrary
                              then [UnitId -> String
getHSLibraryName (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)]
                              else []) forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
extraBundledLibs BuildInfo
bi,
    extraLibraries :: [String]
IPI.extraLibraries     = BuildInfo -> [String]
extraLibs BuildInfo
bi,
    extraGHCiLibraries :: [String]
IPI.extraGHCiLibraries = BuildInfo -> [String]
extraGHCiLibs BuildInfo
bi,
    includeDirs :: [String]
IPI.includeDirs        = [String]
absinc forall a. [a] -> [a] -> [a]
++ [String] -> [String]
adjustRelIncDirs [String]
relinc,
    includes :: [String]
IPI.includes           = BuildInfo -> [String]
includes BuildInfo
bi,
    depends :: [UnitId]
IPI.depends            = [UnitId]
depends,
    abiDepends :: [AbiDependency]
IPI.abiDepends         = [], -- due to #5465
    ccOptions :: [String]
IPI.ccOptions          = [], -- Note. NOT ccOptions bi!
                                 -- We don't want cc-options to be propagated
                                 -- to C compilations in other packages.
    cxxOptions :: [String]
IPI.cxxOptions         = [], -- Also. NOT cxxOptions bi!
    ldOptions :: [String]
IPI.ldOptions          = BuildInfo -> [String]
ldOptions BuildInfo
bi,
    frameworks :: [String]
IPI.frameworks         = BuildInfo -> [String]
frameworks BuildInfo
bi,
    frameworkDirs :: [String]
IPI.frameworkDirs      = BuildInfo -> [String]
extraFrameworkDirs BuildInfo
bi,
    haddockInterfaces :: [String]
IPI.haddockInterfaces  = [forall dir. InstallDirs dir -> dir
haddockdir InstallDirs String
installDirs String -> String -> String
</> PackageDescription -> String
haddockName PackageDescription
pkg],
    haddockHTMLs :: [String]
IPI.haddockHTMLs       = [forall dir. InstallDirs dir -> dir
htmldir InstallDirs String
installDirs],
    pkgRoot :: Maybe String
IPI.pkgRoot            = forall a. Maybe a
Nothing,
    libVisibility :: LibraryVisibility
IPI.libVisibility      = Library -> LibraryVisibility
libVisibility Library
lib
  }
  where
    ghc84 :: Bool
ghc84 = case Compiler -> CompilerId
compilerId forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi of
        CompilerId CompilerFlavor
GHC Version
v -> Version
v 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 = forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi)
    ([String]
absinc, [String]
relinc) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
isAbsolute (BuildInfo -> [String]
includeDirs BuildInfo
bi)
    hasModules :: Bool
hasModules = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
asmSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cmmSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cxxSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
jsSources BuildInfo
bi)) Bool -> Bool -> Bool
&&
                                Compiler -> CompilerFlavor
compilerFlavor Compiler
comp forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHCJS))
               Bool -> Bool -> Bool
&& Bool -> Bool
not (ComponentLocalBuildInfo -> Bool
componentIsIndefinite ComponentLocalBuildInfo
clbi)
    ([String]
libdirs, [String]
dynlibdirs)
      | Bool -> Bool
not Bool
hasLibrary
      = (BuildInfo -> [String]
extraLibDirs BuildInfo
bi, [])
      -- 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
      = (forall dir. InstallDirs dir -> dir
libdir    InstallDirs String
installDirs forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibDirs BuildInfo
bi,
         forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs String
installDirs forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibDirs BuildInfo
bi)

      | Bool
otherwise
      = (forall dir. InstallDirs dir -> dir
libdir InstallDirs String
installDirs forall a. a -> [a] -> [a]
: forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs String
installDirs forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibDirs BuildInfo
bi, [])
      -- 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 :: FilePath -- ^ top of the build tree
                            -> FilePath -- ^ location of the dist tree
                            -> PackageDescription
                            -> AbiHash
                            -> Library
                            -> LocalBuildInfo
                            -> ComponentLocalBuildInfo
                            -> InstalledPackageInfo
inplaceInstalledPackageInfo :: String
-> String
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstalledPackageInfo
inplaceInstalledPackageInfo String
inplaceDir String
distPref PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
    ([String] -> [String])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs String
-> InstalledPackageInfo
generalInstalledPackageInfo [String] -> [String]
adjustRelativeIncludeDirs
                                PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi InstallDirs String
installDirs
  where
    adjustRelativeIncludeDirs :: [String] -> [String]
adjustRelativeIncludeDirs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \String
d ->
      [ String
inplaceDir String -> String -> String
</> String
d                    -- local include-dir
      , String
inplaceDir String -> String -> String
</> String
libTargetDir String -> String -> String
</> String
d   -- autogen include-dir
      ]
    libTargetDir :: String
libTargetDir = LocalBuildInfo -> ComponentLocalBuildInfo -> String
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
    installDirs :: InstallDirs String
installDirs =
      (PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest) {
        libdir :: String
libdir     = String
inplaceDir String -> String -> String
</> String
libTargetDir,
        dynlibdir :: String
dynlibdir  = String
inplaceDir String -> String -> String
</> String
libTargetDir,
        datadir :: String
datadir    = String
inplaceDir String -> String -> String
</> PackageDescription -> String
dataDir PackageDescription
pkg,
        docdir :: String
docdir     = String
inplaceDocdir,
        htmldir :: String
htmldir    = String
inplaceHtmldir,
        haddockdir :: String
haddockdir = String
inplaceHtmldir
      }
    inplaceDocdir :: String
inplaceDocdir  = String
inplaceDir String -> String -> String
</> String
distPref String -> String -> String
</> String
"doc"
    inplaceHtmldir :: String
inplaceHtmldir = String
inplaceDocdir String -> String -> String
</> String
"html" String -> String -> String
</> forall a. Pretty a => a -> String
prettyShow (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 =
    ([String] -> [String])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs String
-> InstalledPackageInfo
generalInstalledPackageInfo forall {p}. p -> [String]
adjustReativeIncludeDirs
                                PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi InstallDirs String
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 -> [String]
adjustReativeIncludeDirs p
_
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise                 = [forall dir. InstallDirs dir -> dir
includedir InstallDirs String
installDirs]
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
    installDirs :: InstallDirs String
installDirs = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest


relocatableInstalledPackageInfo :: PackageDescription
                                -> AbiHash
                                -> Library
                                -> LocalBuildInfo
                                -> ComponentLocalBuildInfo
                                -> FilePath
                                -> InstalledPackageInfo
relocatableInstalledPackageInfo :: PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> String
-> InstalledPackageInfo
relocatableInstalledPackageInfo PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi String
pkgroot =
    ([String] -> [String])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs String
-> InstalledPackageInfo
generalInstalledPackageInfo forall {p}. p -> [String]
adjustReativeIncludeDirs
                                PackageDescription
pkg AbiHash
abi_hash Library
lib LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi InstallDirs String
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 -> [String]
adjustReativeIncludeDirs p
_
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise                 = [forall dir. InstallDirs dir -> dir
includedir InstallDirs String
installDirs]
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib

    installDirs :: InstallDirs String
installDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"${pkgroot}" String -> String -> String
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
shortRelativePath String
pkgroot)
                forall a b. (a -> b) -> a -> b
$ PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
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     = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
      genScript :: Bool
genScript = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Bool
regGenScript RegisterFlags
regFlags)
      verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
regFlags)
      packageDb :: PackageDB
packageDb = forall a. a -> Flag a -> a
fromFlagOrDefault (PackageDBStack -> PackageDB
registrationPackageDB (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi))
                                    (RegisterFlags -> Flag PackageDB
regPackageDB RegisterFlags
regFlags)
      unreg :: HcPkgInfo -> IO ()
unreg HcPkgInfo
hpi =
        let invocation :: ProgramInvocation
invocation = HcPkgInfo
-> Verbosity -> PackageDB -> PackageIdentifier -> ProgramInvocation
HcPkg.unregisterInvocation
                           HcPkgInfo
hpi Verbosity
Verbosity.normal PackageDB
packageDb PackageIdentifier
pkgid
        in if Bool
genScript
             then String -> ByteString -> IO ()
writeFileAtomic String
unregScriptFileName
                    (String -> ByteString
BS.Char8.pack forall a b. (a -> b) -> a -> b
$ OS -> ProgramInvocation -> String
invocationAsSystemScript OS
buildOS ProgramInvocation
invocation)
             else Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
invocation
  Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity String
"Unregistering" PackageIdentifier
pkgid
  forall a.
Verbosity
-> String -> Compiler -> ProgramDb -> (HcPkgInfo -> IO a) -> IO a
withHcPkg Verbosity
verbosity String
"unregistering is only implemented for GHC and GHCJS"
    (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) HcPkgInfo -> IO ()
unreg

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

internalPackageDBPath :: LocalBuildInfo -> FilePath -> FilePath
internalPackageDBPath :: LocalBuildInfo -> String -> String
internalPackageDBPath LocalBuildInfo
lbi String
distPref =
      case Compiler -> CompilerFlavor
compilerFlavor (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        CompilerFlavor
UHC -> LocalBuildInfo -> String
UHC.inplacePackageDbPath LocalBuildInfo
lbi
        CompilerFlavor
_   -> String
distPref String -> String -> String
</> String
"package.conf.inplace"