{-# 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 ((TargetInfo -> UnitId) -> [TargetInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map TargetInfo -> UnitId
forall a. IsNode a => a -> Key a
nodeKey [TargetInfo]
targets)

    (InstalledPackageIndex
_, [Maybe InstalledPackageInfo]
ipi_mbs) <-
        (InstalledPackageIndex
 -> TargetInfo
 -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
-> InstalledPackageIndex
-> [TargetInfo]
-> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo])
forall (m :: * -> *) (t :: * -> *) a b c.
(Monad m, Traversable t) =>
(a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM ((InstalledPackageIndex
  -> TargetInfo
  -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
 -> InstalledPackageIndex
 -> [TargetInfo]
 -> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo]))
-> InstalledPackageIndex
-> (InstalledPackageIndex
    -> TargetInfo
    -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
-> [TargetInfo]
-> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo])
forall a b c. (a -> b -> c) -> b -> a -> c
`flip` LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi0 ((InstalledPackageIndex
  -> TargetInfo
  -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
 -> [TargetInfo]
 -> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo]))
-> [TargetInfo]
-> (InstalledPackageIndex
    -> TargetInfo
    -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
-> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo])
forall a b c. (a -> b -> c) -> b -> a -> c
`flip` [TargetInfo]
componentsToRegister ((InstalledPackageIndex
  -> TargetInfo
  -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
 -> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo]))
-> (InstalledPackageIndex
    -> TargetInfo
    -> IO (InstalledPackageIndex, Maybe InstalledPackageInfo))
-> IO (InstalledPackageIndex, [Maybe InstalledPackageInfo])
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
                    (InstalledPackageIndex, Maybe InstalledPackageInfo)
-> IO (InstalledPackageIndex, Maybe InstalledPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageInfo
-> InstalledPackageIndex -> InstalledPackageIndex
Index.insert InstalledPackageInfo
ipi InstalledPackageIndex
index, InstalledPackageInfo -> Maybe InstalledPackageInfo
forall a. a -> Maybe a
Just InstalledPackageInfo
ipi)
                Component
_   -> (InstalledPackageIndex, Maybe InstalledPackageInfo)
-> IO (InstalledPackageIndex, Maybe InstalledPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex
index, Maybe InstalledPackageInfo
forall a. Maybe a
Nothing)

    PackageDescription
-> LocalBuildInfo
-> RegisterFlags
-> [InstalledPackageInfo]
-> IO ()
registerAll PackageDescription
pkg_descr LocalBuildInfo
lbi0 RegisterFlags
flags ([Maybe InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. [Maybe a] -> [a]
catMaybes [Maybe InstalledPackageInfo]
ipi_mbs)
   where
    verbosity :: Verbosity
verbosity = Flag 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)
    InstalledPackageInfo -> IO InstalledPackageInfo
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
installedPkgInfo
  where
    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 :: String
distPref  = Flag String -> String
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag String
regDistPref RegisterFlags
regFlags)
    verbosity :: Verbosity
verbosity = Flag 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
    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
$
          String -> IO ()
putStrLn (UnitId -> String
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
           [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
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, OpenModule)]
-> IO ()
forall a.
Pretty a =>
Verbosity
-> String
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity String
"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
-> 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 = Maybe (Maybe String) -> Bool
forall a. Maybe a -> Bool
isJust (Flag (Maybe String) -> Maybe (Maybe String)
forall a. Flag a -> Maybe a
flagToMaybe (RegisterFlags -> Flag (Maybe String)
regGenPkgConf RegisterFlags
regFlags))
    regFile :: String
regFile             = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) String -> String -> String
<.> String
"conf")
                                    (Flag (Maybe String) -> Maybe String
forall a. WithCallStack (Flag a -> a)
fromFlag (RegisterFlags -> Flag (Maybe String)
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))
    verbosity :: Verbosity
verbosity = Flag 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: " String -> String -> String
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: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
regFile)
          String -> IO ()
createDirectory String
regFile
          let num_ipis :: Int
num_ipis = [InstalledPackageInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstalledPackageInfo]
ipis
              lpad :: Int -> String -> String
lpad Int
m String
xs = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ys) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ys
                  where ys :: String
ys = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
m String
xs
              number :: a -> String
number a
i = Int -> String -> String
lpad (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
num_ipis)) (a -> String
forall a. Show a => a -> String
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) ->
            String -> String -> IO ()
writeUTF8File (String
regFile String -> String -> String
</> (Int -> String
forall a. Show a => a -> String
number Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitId -> String
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
_   -> Verbosity
-> String -> Compiler -> ProgramDb -> (HcPkgInfo -> IO ()) -> IO ()
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 InstalledPackageInfo -> IO InstalledPackageInfo
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 InstalledPackageInfo -> IO InstalledPackageInfo
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)


  InstalledPackageInfo -> IO InstalledPackageInfo
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
            (String -> AbiHash) -> IO String -> IO AbiHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AbiHash
mkAbiHash (IO String -> IO AbiHash) -> IO String -> IO AbiHash
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
            (String -> AbiHash) -> IO String -> IO AbiHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AbiHash
mkAbiHash (IO String -> IO AbiHash) -> IO String -> IO AbiHash
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
_ -> AbiHash -> IO AbiHash
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
                  PackageDBStack -> PackageDBStack -> PackageDBStack
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
              InstalledPackageInfo -> IO InstalledPackageInfo
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
_   -> Verbosity -> String -> IO InstalledPackageInfo
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   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HaskellSuite String
_ -> Verbosity -> ProgramDb -> String -> IO ()
HaskellSuite.initPackageDB Verbosity
verbosity ProgramDb
progdb String
dbPath
      CompilerFlavor
_              -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                              String
"Distribution.Simple.Register.createPackageDB: "
                           String -> String -> String
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 Bool -> IO Bool
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
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
file_exists (IO () -> IO ()) -> IO () -> IO ()
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 =
  Verbosity
-> String -> Compiler -> ProgramDb -> (HcPkgInfo -> IO ()) -> IO ()
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
_     -> Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String
"Distribution.Simple.Register." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
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
          -> Verbosity -> String -> IO ()
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
_    -> Verbosity -> String -> IO ()
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 = (InstalledPackageInfo -> String)
-> [InstalledPackageInfo] -> [String]
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: " String -> String -> String
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    = 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 :: 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 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 :: [String]
IPI.importDirs         = [ InstallDirs String -> String
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            = InstallDirs String -> String
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 []) [String] -> [String] -> [String]
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 [String] -> [String] -> [String]
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  = [InstallDirs String -> String
forall dir. InstallDirs dir -> dir
haddockdir InstallDirs String
installDirs String -> String -> String
</> PackageDescription -> String
haddockName PackageDescription
pkg],
    haddockHTMLs :: [String]
IPI.haddockHTMLs       = [InstallDirs String -> String
forall dir. InstallDirs dir -> dir
htmldir InstallDirs String
installDirs],
    pkgRoot :: Maybe String
IPI.pkgRoot            = Maybe String
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)
    ([String]
absinc, [String]
relinc) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition String -> Bool
isAbsolute (BuildInfo -> [String]
includeDirs BuildInfo
bi)
    hasModules :: Bool
hasModules = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ModuleName] -> 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 ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
asmSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cmmSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
cxxSources BuildInfo
bi))
                             Bool -> Bool -> Bool
|| (Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
jsSources BuildInfo
bi)) Bool -> Bool -> Bool
&&
                                Compiler -> CompilerFlavor
compilerFlavor Compiler
comp CompilerFlavor -> CompilerFlavor -> Bool
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
      = (InstallDirs String -> String
forall dir. InstallDirs dir -> dir
libdir    InstallDirs String
installDirs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibDirs BuildInfo
bi,
         InstallDirs String -> String
forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs String
installDirs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BuildInfo -> [String]
extraLibDirs BuildInfo
bi)

      | Bool
otherwise
      = (InstallDirs String -> String
forall dir. InstallDirs dir -> dir
libdir InstallDirs String
installDirs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: InstallDirs String -> String
forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs String
installDirs String -> [String] -> [String]
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 = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> [String]) -> [String] -> [String])
-> (String -> [String]) -> [String] -> [String]
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
</> PackageName -> String
forall a. Pretty a => a -> String
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 =
    ([String] -> [String])
-> PackageDescription
-> AbiHash
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> InstallDirs String
-> InstalledPackageInfo
generalInstalledPackageInfo [String] -> [String]
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
_
      | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise                 = [InstallDirs String -> String
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 [String] -> [String]
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
_
      | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [String]
installIncludes BuildInfo
bi) = []
      | Bool
otherwise                 = [InstallDirs String -> String
forall dir. InstallDirs dir -> dir
includedir InstallDirs String
installDirs]
    bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib

    installDirs :: InstallDirs String
installDirs = (String -> String) -> InstallDirs String -> InstallDirs String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"${pkgroot}" String -> String -> String
</>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
shortRelativePath String
pkgroot)
                (InstallDirs String -> InstallDirs String)
-> InstallDirs String -> InstallDirs String
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     = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
      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 (RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
regFlags)
      packageDb :: PackageDB
packageDb = PackageDB -> Flag 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 (String -> ByteString) -> String -> ByteString
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
  Verbosity
-> String -> Compiler -> ProgramDb -> (HcPkgInfo -> IO ()) -> IO ()
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"