Register.hs 25 KB
Newer Older
1 2 3
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

4 5
-----------------------------------------------------------------------------
-- |
ijones's avatar
ijones committed
6
-- Module      :  Distribution.Simple.Register
7
-- Copyright   :  Isaac Jones 2003-2004
8
-- License     :  BSD3
9
--
Duncan Coutts's avatar
Duncan Coutts committed
10
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
11
-- Portability :  portable
12
--
Duncan Coutts's avatar
Duncan Coutts committed
13 14 15 16 17 18 19 20
-- 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,
Ian D. Bollinger's avatar
Ian D. Bollinger committed
21
-- or alternatively to register the package in place in the build tree. The
Duncan Coutts's avatar
Duncan Coutts committed
22 23 24 25 26 27
-- 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 in this module, which is rather unsatisfactory. The script
-- generation and the unregister feature are not well used or tested.
28

29
module Distribution.Simple.Register (
Duncan Coutts's avatar
Duncan Coutts committed
30 31 32
    register,
    unregister,

33 34
    internalPackageDBPath,

35
    initPackageDB,
36 37 38 39
    doesPackageDBExist,
    createPackageDB,
    deletePackageDB,

40
    abiHash,
refold's avatar
refold committed
41
    invokeHcPkg,
Duncan Coutts's avatar
Duncan Coutts committed
42
    registerPackage,
43 44
    HcPkg.RegisterOptions(..),
    HcPkg.defaultRegisterOptions,
45
    generateRegistrationInfo,
Duncan Coutts's avatar
Duncan Coutts committed
46 47 48
    inplaceInstalledPackageInfo,
    absoluteInstalledPackageInfo,
    generalInstalledPackageInfo,
49
  ) where
50

51 52 53
import Prelude ()
import Distribution.Compat.Prelude

54 55
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
56
import Distribution.Types.ComponentLocalBuildInfo
57

58
import Distribution.Simple.LocalBuildInfo
59
import Distribution.Simple.BuildPaths
60
import Distribution.Simple.BuildTarget
61 62 63 64 65

import qualified Distribution.Simple.GHC   as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.LHC   as LHC
import qualified Distribution.Simple.UHC   as UHC
66
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
67
import qualified Distribution.Simple.PackageIndex as Index
68

69
import Distribution.Backpack.DescribeUnitId
70
import Distribution.Simple.Compiler
Duncan Coutts's avatar
Duncan Coutts committed
71 72 73
import Distribution.Simple.Program
import Distribution.Simple.Program.Script
import qualified Distribution.Simple.Program.HcPkg as HcPkg
74
import Distribution.Simple.Setup
Duncan Coutts's avatar
Duncan Coutts committed
75
import Distribution.PackageDescription
76
import Distribution.Package
77
import qualified Distribution.InstalledPackageInfo as IPI
78
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
79
import Distribution.Simple.Utils
80
import Distribution.Utils.MapAccum
81
import Distribution.System
82
import Distribution.Text
83
import Distribution.Types.ComponentName
Duncan Coutts's avatar
Duncan Coutts committed
84
import Distribution.Verbosity as Verbosity
85
import Distribution.Version
86
import Distribution.Compat.Graph (IsNode(nodeKey))
87

88
import System.FilePath ((</>), (<.>), isAbsolute)
Duncan Coutts's avatar
Duncan Coutts committed
89
import System.Directory
ijones's avatar
ijones committed
90

91
import Data.List (partition)
92
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
93

simonmar's avatar
simonmar committed
94 95 96
-- -----------------------------------------------------------------------------
-- Registration

ijones's avatar
ijones committed
97
register :: PackageDescription -> LocalBuildInfo
ijones's avatar
ijones committed
98
         -> RegisterFlags -- ^Install in the user's database?; verbose
ijones's avatar
ijones committed
99
         -> IO ()
100
register pkg_descr lbi0 flags =
101 102 103 104 105
   -- 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.
   doRegister
106 107
 where
  doRegister = do
108
    targets <- readTargetInfos verbosity pkg_descr lbi0 (regArgs flags)
109 110 111

    -- It's important to register in build order, because ghc-pkg
    -- will complain if a dependency is not registered.
112 113 114 115 116 117 118 119 120 121 122 123 124 125
    let componentsToRegister
            = neededTargetsInBuildOrder' pkg_descr lbi0 (map nodeKey targets)

    (_, ipi_mbs) <-
        mapAccumM `flip` installedPkgs lbi0 `flip` componentsToRegister $ \index tgt ->
            case targetComponent tgt of
                CLib lib -> do
                    let clbi = targetCLBI tgt
                        lbi = lbi0 { installedPkgs = index }
                    ipi <- generateOne pkg_descr lib lbi clbi flags
                    return (Index.insert ipi index, Just ipi)
                _   -> return (index, Nothing)

    registerAll pkg_descr lbi0 flags (catMaybes ipi_mbs)
126 127
   where
    verbosity = fromFlag (regVerbosity flags)
128 129 130 131 132

generateOne :: PackageDescription -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo
            -> RegisterFlags
            -> IO InstalledPackageInfo
generateOne pkg lib lbi clbi regFlags
133
  = do
134
    absPackageDBs    <- absolutePackageDBPaths packageDbs
135
    installedPkgInfo <- generateRegistrationInfo
136
                           verbosity pkg lib lbi clbi inplace reloc distPref
137
                           (registrationPackageDB absPackageDBs)
138
    info verbosity (IPI.showInstalledPackageInfo installedPkgInfo)
139 140 141 142 143 144 145 146 147 148 149
    return installedPkgInfo
  where
    inplace   = fromFlag (regInPlace regFlags)
    reloc     = relocatable 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 = nub $ withPackageDB lbi
                    ++ maybeToList (flagToMaybe  (regPackageDB regFlags))
    distPref  = fromFlag (regDistPref regFlags)
    verbosity = fromFlag (regVerbosity regFlags)
150

151 152 153 154 155
registerAll :: PackageDescription -> LocalBuildInfo -> RegisterFlags
            -> [InstalledPackageInfo]
            -> IO ()
registerAll pkg lbi regFlags ipis
  = do
156
    when (fromFlag (regPrintId regFlags)) $ do
157
      for_ ipis $ \installedPkgInfo ->
158
        -- Only print the public library's IPI
159 160
        when (packageId installedPkgInfo == packageId pkg
              && IPI.sourceLibName installedPkgInfo == Nothing) $
161
          putStrLn (display (IPI.installedUnitId installedPkgInfo))
162

163 164
     -- Three different modes:
    case () of
165 166
     _ | modeGenerateRegFile   -> writeRegistrationFileOrDirectory
       | modeGenerateRegScript -> writeRegisterScript
167
       | otherwise             -> do
168 169 170 171
           for_ ipis $ \ipi -> do
               setupMessage' verbosity "Registering" (packageId pkg)
                 (libraryComponentName (IPI.sourceLibName ipi))
                 (Just (IPI.instantiatedWith ipi))
172
               registerPackage verbosity (compiler lbi) (withPrograms lbi)
173
                               packageDbs ipi HcPkg.defaultRegisterOptions
Duncan Coutts's avatar
Duncan Coutts committed
174 175 176 177 178 179 180 181

  where
    modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
    regFile             = fromMaybe (display (packageId pkg) <.> "conf")
                                    (fromFlag (regGenPkgConf regFlags))

    modeGenerateRegScript = fromFlag (regGenScript regFlags)

Duncan Coutts's avatar
Duncan Coutts committed
182 183 184 185 186
    -- FIXME: there's really no guarantee this will work.
    -- registering into a totally different db stack can
    -- fail if dependencies cannot be satisfied.
    packageDbs = nub $ withPackageDB lbi
                    ++ maybeToList (flagToMaybe  (regPackageDB regFlags))
Duncan Coutts's avatar
Duncan Coutts committed
187 188
    verbosity = fromFlag (regVerbosity regFlags)

189 190 191 192 193
    writeRegistrationFileOrDirectory = do
      -- Handles overwriting both directory and file
      deletePackageDB regFile
      case ipis of
        [installedPkgInfo] -> do
194
          info verbosity ("Creating package registration file: " ++ regFile)
195 196
          writeUTF8File regFile (IPI.showInstalledPackageInfo installedPkgInfo)
        _ -> do
197
          info verbosity ("Creating package registration directory: " ++ regFile)
198 199 200 201 202
          createDirectory regFile
          let num_ipis = length ipis
              lpad m xs = replicate (m - length ys) '0' ++ ys
                  where ys = take m xs
              number i = lpad (length (show num_ipis)) (show i)
203
          for_ (zip ([1..] :: [Int]) ipis) $ \(i, installedPkgInfo) ->
204 205 206 207
            writeUTF8File (regFile </> (number i ++ "-" ++ display (IPI.installedUnitId installedPkgInfo)))
                          (IPI.showInstalledPackageInfo installedPkgInfo)

    writeRegisterScript =
Duncan Coutts's avatar
Duncan Coutts committed
208
      case compilerFlavor (compiler lbi) of
209 210
        JHC -> notice verbosity "Registration scripts not needed for jhc"
        UHC -> notice verbosity "Registration scripts not needed for uhc"
211
        _   -> withHcPkg verbosity
212 213
               "Registration scripts are not implemented for this compiler"
               (compiler lbi) (withPrograms lbi)
214
               (writeHcPkgRegisterScript verbosity ipis packageDbs)
Duncan Coutts's avatar
Duncan Coutts committed
215 216


217 218
generateRegistrationInfo :: Verbosity
                         -> PackageDescription
Duncan Coutts's avatar
Duncan Coutts committed
219 220 221 222
                         -> Library
                         -> LocalBuildInfo
                         -> ComponentLocalBuildInfo
                         -> Bool
223
                         -> Bool
Duncan Coutts's avatar
Duncan Coutts committed
224
                         -> FilePath
225
                         -> PackageDB
Duncan Coutts's avatar
Duncan Coutts committed
226
                         -> IO InstalledPackageInfo
227
generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packageDb = do
Duncan Coutts's avatar
Duncan Coutts committed
228 229
  --TODO: eliminate pwd!
  pwd <- getCurrentDirectory
230

Christiaan Baaij's avatar
Christiaan Baaij committed
231 232
  installedPkgInfo <-
    if inplace
233 234 235
      -- 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.
Christiaan Baaij's avatar
Christiaan Baaij committed
236
      then return (inplaceInstalledPackageInfo pwd distPref
237 238 239 240 241 242 243 244
                     pkg (mkAbiHash "inplace") lib lbi clbi)
    else do
        abi_hash <- abiHash verbosity pkg distPref lbi lib clbi
        if reloc
          then relocRegistrationInfo verbosity
                         pkg lib lbi clbi abi_hash packageDb
          else return (absoluteInstalledPackageInfo
                         pkg abi_hash lib lbi clbi)
245

246

247
  return installedPkgInfo
248

249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
-- | Compute the 'AbiHash' of a library that we built inplace.
abiHash :: Verbosity
        -> PackageDescription
        -> FilePath
        -> LocalBuildInfo
        -> Library
        -> ComponentLocalBuildInfo
        -> IO AbiHash
abiHash verbosity pkg distPref lbi lib clbi =
    case compilerFlavor comp of
     GHC | compilerVersion comp >= mkVersion [6,11] -> do
            fmap mkAbiHash $ GHC.libAbiHash verbosity pkg lbi' lib clbi
     GHCJS -> do
            fmap mkAbiHash $ GHCJS.libAbiHash verbosity pkg lbi' lib clbi
     _ -> return (mkAbiHash "")
  where
    comp = compiler lbi
    lbi' = lbi {
              withPackageDB = withPackageDB lbi
                  ++ [SpecificPackageDB (internalPackageDBPath lbi distPref)]
           }

271 272 273 274 275
relocRegistrationInfo :: Verbosity
                      -> PackageDescription
                      -> Library
                      -> LocalBuildInfo
                      -> ComponentLocalBuildInfo
276
                      -> AbiHash
277 278
                      -> PackageDB
                      -> IO InstalledPackageInfo
279
relocRegistrationInfo verbosity pkg lib lbi clbi abi_hash packageDb =
280
  case (compilerFlavor (compiler lbi)) of
281 282
    GHC -> do fs <- GHC.pkgRoot verbosity lbi packageDb
              return (relocatableInstalledPackageInfo
283
                        pkg abi_hash lib lbi clbi fs)
284 285
    _   -> die' verbosity
              "Distribution.Simple.Register.relocRegistrationInfo: \
286
               \not implemented for this compiler"
287

288
initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO ()
289
initPackageDB verbosity comp progdb dbPath =
290
    createPackageDB verbosity comp progdb False dbPath
291

292
-- | Create an empty package DB at the specified location.
293
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool
294 295 296 297 298 299 300 301
                -> FilePath -> IO ()
createPackageDB verbosity comp progdb preferCompat dbPath =
    case compilerFlavor comp of
      GHC   -> HcPkg.init (GHC.hcPkgInfo   progdb) verbosity preferCompat dbPath
      GHCJS -> HcPkg.init (GHCJS.hcPkgInfo progdb) verbosity False dbPath
      LHC   -> HcPkg.init (LHC.hcPkgInfo   progdb) verbosity False dbPath
      UHC   -> return ()
      HaskellSuite _ -> HaskellSuite.initPackageDB verbosity progdb dbPath
302 303
      _              -> die' verbosity $
                              "Distribution.Simple.Register.createPackageDB: "
304 305
                           ++ "not implemented for this compiler"

306
doesPackageDBExist :: FilePath -> NoCallStackIO Bool
307 308 309 310 311 312 313
doesPackageDBExist dbPath = do
    -- currently one impl for all compiler flavours, but could change if needed
    dir_exists <- doesDirectoryExist dbPath
    if dir_exists
        then return True
        else doesFileExist dbPath

314
deletePackageDB :: FilePath -> NoCallStackIO ()
315 316 317 318 319 320 321
deletePackageDB dbPath = do
    -- currently one impl for all compiler flavours, but could change if needed
    dir_exists <- doesDirectoryExist dbPath
    if dir_exists
        then removeDirectoryRecursive dbPath
        else do file_exists <- doesFileExist dbPath
                when file_exists $ removeFile dbPath
refold's avatar
refold committed
322 323 324

-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
325
invokeHcPkg :: Verbosity -> Compiler -> ProgramDb -> PackageDBStack
refold's avatar
refold committed
326
                -> [String] -> IO ()
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
327
invokeHcPkg verbosity comp progdb dbStack extraArgs =
328
  withHcPkg verbosity "invokeHcPkg" comp progdb
329 330
    (\hpi -> HcPkg.invoke hpi verbosity dbStack extraArgs)

331
withHcPkg :: Verbosity -> String -> Compiler -> ProgramDb
332
          -> (HcPkg.HcPkgInfo -> IO a) -> IO a
333
withHcPkg verbosity name comp progdb f =
334
  case compilerFlavor comp of
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
335 336 337
    GHC   -> f (GHC.hcPkgInfo progdb)
    GHCJS -> f (GHCJS.hcPkgInfo progdb)
    LHC   -> f (LHC.hcPkgInfo progdb)
338
    _     -> die' verbosity ("Distribution.Simple.Register." ++ name ++ ":\
339
                  \not implemented for this compiler")
340

Duncan Coutts's avatar
Duncan Coutts committed
341
registerPackage :: Verbosity
342
                -> Compiler
343
                -> ProgramDb
344
                -> PackageDBStack
345
                -> InstalledPackageInfo
346
                -> HcPkg.RegisterOptions
Duncan Coutts's avatar
Duncan Coutts committed
347
                -> IO ()
348
registerPackage verbosity comp progdb packageDbs installedPkgInfo registerOptions =
349
  case compilerFlavor comp of
350 351 352
    GHC   -> GHC.registerPackage   verbosity progdb packageDbs installedPkgInfo registerOptions
    GHCJS -> GHCJS.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
    _ | HcPkg.registerMultiInstance registerOptions
353
          -> die' verbosity "Registering multiple package instances is not yet supported for this compiler"
354
    LHC   -> LHC.registerPackage   verbosity      progdb packageDbs installedPkgInfo registerOptions
355
    UHC   -> UHC.registerPackage   verbosity comp progdb packageDbs installedPkgInfo
356
    JHC   -> notice verbosity "Registering for jhc (nothing to do)"
357
    HaskellSuite {} ->
358
      HaskellSuite.registerPackage verbosity      progdb packageDbs installedPkgInfo
359
    _    -> die' verbosity "Registering is not implemented for this compiler"
Duncan Coutts's avatar
Duncan Coutts committed
360 361

writeHcPkgRegisterScript :: Verbosity
362
                         -> [InstalledPackageInfo]
363
                         -> PackageDBStack
364
                         -> HcPkg.HcPkgInfo
Duncan Coutts's avatar
Duncan Coutts committed
365
                         -> IO ()
366 367
writeHcPkgRegisterScript verbosity ipis packageDbs hpi = do
  let genScript installedPkgInfo =
368 369 370
          let invocation  = HcPkg.registerInvocation hpi Verbosity.normal
                              packageDbs installedPkgInfo
                              HcPkg.defaultRegisterOptions
371 372 373 374
          in invocationAsSystemScript buildOS invocation
      scripts = map genScript ipis
      -- TODO: Do something more robust here
      regScript = unlines scripts
Duncan Coutts's avatar
Duncan Coutts committed
375

376
  info verbosity ("Creating package registration script: " ++ regScriptFileName)
377
  writeUTF8File regScriptFileName regScript
Duncan Coutts's avatar
Duncan Coutts committed
378 379 380 381 382 383
  setFileExecutable regScriptFileName

regScriptFileName :: FilePath
regScriptFileName = case buildOS of
                        Windows -> "register.bat"
                        _       -> "register.sh"
simonmar's avatar
simonmar committed
384

385

386 387 388
-- -----------------------------------------------------------------------------
-- Making the InstalledPackageInfo

Duncan Coutts's avatar
Duncan Coutts committed
389 390 391 392 393 394 395
-- | 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
396
  -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
397
  -> Library
398
  -> LocalBuildInfo
Duncan Coutts's avatar
Duncan Coutts committed
399 400 401
  -> ComponentLocalBuildInfo
  -> InstallDirs FilePath
  -> InstalledPackageInfo
402
generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDirs =
403
  IPI.InstalledPackageInfo {
404
    IPI.sourcePackageId    = packageId pkg,
405
    IPI.installedUnitId    = componentUnitId clbi,
406
    IPI.installedComponentId_ = componentComponentId clbi,
407
    IPI.instantiatedWith   = componentInstantiatedWith clbi,
408
    IPI.sourceLibName      = libName lib,
409
    IPI.compatPackageKey   = componentCompatPackageKey clbi,
Duncan Coutts's avatar
Duncan Coutts committed
410 411 412 413 414 415 416
    IPI.license            = license     pkg,
    IPI.copyright          = copyright   pkg,
    IPI.maintainer         = maintainer  pkg,
    IPI.author             = author      pkg,
    IPI.stability          = stability   pkg,
    IPI.homepage           = homepage    pkg,
    IPI.pkgUrl             = pkgUrl      pkg,
417
    IPI.synopsis           = synopsis    pkg,
Duncan Coutts's avatar
Duncan Coutts committed
418 419
    IPI.description        = description pkg,
    IPI.category           = category    pkg,
420
    IPI.abiHash            = abi_hash,
421
    IPI.indefinite         = componentIsIndefinite clbi,
Duncan Coutts's avatar
Duncan Coutts committed
422
    IPI.exposed            = libExposed  lib,
423
    IPI.exposedModules     = componentExposedModules clbi,
Duncan Coutts's avatar
Duncan Coutts committed
424
    IPI.hiddenModules      = otherModules bi,
425
    IPI.trusted            = IPI.trusted IPI.emptyInstalledPackageInfo,
Duncan Coutts's avatar
Duncan Coutts committed
426
    IPI.importDirs         = [ libdir installDirs | hasModules ],
Christiaan Baaij's avatar
Christiaan Baaij committed
427 428
    IPI.libraryDirs        = libdirs,
    IPI.libraryDynDirs     = dynlibdirs,
429
    IPI.dataDir            = datadir installDirs,
430 431 432 433
    IPI.hsLibraries        = extraBundledLibs bi
                             ++ if hasLibrary
                                then [getHSLibraryName (componentUnitId clbi)]
                                else [],
Duncan Coutts's avatar
Duncan Coutts committed
434
    IPI.extraLibraries     = extraLibs bi,
435
    IPI.extraGHCiLibraries = extraGHCiLibs bi,
Duncan Coutts's avatar
Duncan Coutts committed
436 437
    IPI.includeDirs        = absinc ++ adjustRelIncDirs relinc,
    IPI.includes           = includes bi,
438 439
    IPI.depends            = depends,
    IPI.abiDepends         = abi_depends,
Duncan Coutts's avatar
Duncan Coutts committed
440 441 442 443 444
    IPI.ccOptions          = [], -- Note. NOT ccOptions bi!
                                 -- We don't want cc-options to be propagated
                                 -- to C compilations in other packages.
    IPI.ldOptions          = ldOptions bi,
    IPI.frameworks         = frameworks bi,
445
    IPI.frameworkDirs      = extraFrameworkDirs bi,
Duncan Coutts's avatar
Duncan Coutts committed
446
    IPI.haddockInterfaces  = [haddockdir installDirs </> haddockName pkg],
447 448
    IPI.haddockHTMLs       = [htmldir installDirs],
    IPI.pkgRoot            = Nothing
Duncan Coutts's avatar
Duncan Coutts committed
449 450 451
  }
  where
    bi = libBuildInfo lib
452 453 454 455 456 457 458 459 460 461
    --TODO: unclear what the root cause of the
    -- duplication is, but we nub it here for now:
    depends = ordNub $ map fst (componentPackageDeps clbi)
    abi_depends = map add_abi depends
    add_abi uid = IPI.AbiDependency uid abi
      where
        abi = case Index.lookupUnitId (installedPkgs lbi) uid of
                Nothing -> error $
                  "generalInstalledPackageInfo: missing IPI for " ++ display uid
                Just ipi -> IPI.abiHash ipi
Duncan Coutts's avatar
Duncan Coutts committed
462
    (absinc, relinc) = partition isAbsolute (includeDirs bi)
463
    hasModules = not $ null (allLibModules lib clbi)
Christiaan Baaij's avatar
Christiaan Baaij committed
464
    comp = compiler lbi
465
    hasLibrary = (hasModules || not (null (cSources bi))
466
                             || not (null (asmSources bi))
467
                             || not (null (cmmSources bi))
468
                             || not (null (cxxSources bi))
469 470 471
                             || (not (null (jsSources bi)) &&
                                compilerFlavor comp == GHCJS))
               && not (componentIsIndefinite clbi)
Christiaan Baaij's avatar
Christiaan Baaij committed
472 473 474 475 476 477 478 479 480 481 482 483 484 485
    (libdirs, dynlibdirs)
      | not hasLibrary
      = (extraLibDirs 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

      | libraryDynDirSupported comp
      = (libdir    installDirs : extraLibDirs bi,
         dynlibdir installDirs : extraLibDirs bi)

      | otherwise
      = (libdir installDirs : dynlibdir installDirs : extraLibDirs 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
486

Ian D. Bollinger's avatar
Ian D. Bollinger committed
487
-- | Construct 'InstalledPackageInfo' for a library that is in place in the
Duncan Coutts's avatar
Duncan Coutts committed
488 489
-- build tree.
--
Ian D. Bollinger's avatar
Ian D. Bollinger committed
490
-- This function knows about the layout of in place packages.
Duncan Coutts's avatar
Duncan Coutts committed
491 492 493 494
--
inplaceInstalledPackageInfo :: FilePath -- ^ top of the build tree
                            -> FilePath -- ^ location of the dist tree
                            -> PackageDescription
495
                            -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
496 497 498 499
                            -> Library
                            -> LocalBuildInfo
                            -> ComponentLocalBuildInfo
                            -> InstalledPackageInfo
500
inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
501
    generalInstalledPackageInfo adjustRelativeIncludeDirs
502
                                pkg abi_hash lib lbi clbi installDirs
Duncan Coutts's avatar
Duncan Coutts committed
503
  where
refold's avatar
refold committed
504
    adjustRelativeIncludeDirs = map (inplaceDir </>)
505
    libTargetDir = componentBuildDir lbi clbi
Duncan Coutts's avatar
Duncan Coutts committed
506
    installDirs =
507
      (absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest) {
508
        libdir     = inplaceDir </> libTargetDir,
Christiaan Baaij's avatar
Christiaan Baaij committed
509
        dynlibdir  = inplaceDir </> libTargetDir,
510
        datadir    = inplaceDir </> dataDir pkg,
Duncan Coutts's avatar
Duncan Coutts committed
511 512 513 514 515 516 517 518 519 520 521 522 523 524
        docdir     = inplaceDocdir,
        htmldir    = inplaceHtmldir,
        haddockdir = inplaceHtmldir
      }
    inplaceDocdir  = inplaceDir </> distPref </> "doc"
    inplaceHtmldir = inplaceDocdir </> "html" </> display (packageName pkg)


-- | Construct 'InstalledPackageInfo' for the final install location of a
-- library package.
--
-- This function knows about the layout of installed packages.
--
absoluteInstalledPackageInfo :: PackageDescription
525
                             -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
526 527 528 529
                             -> Library
                             -> LocalBuildInfo
                             -> ComponentLocalBuildInfo
                             -> InstalledPackageInfo
530
absoluteInstalledPackageInfo pkg abi_hash lib lbi clbi =
531
    generalInstalledPackageInfo adjustReativeIncludeDirs
532
                                pkg abi_hash lib lbi clbi installDirs
Duncan Coutts's avatar
Duncan Coutts committed
533 534 535 536 537 538 539
  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 _
      | null (installIncludes bi) = []
      | otherwise                 = [includedir installDirs]
    bi = libBuildInfo lib
540
    installDirs = absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest
Duncan Coutts's avatar
Duncan Coutts committed
541

542 543

relocatableInstalledPackageInfo :: PackageDescription
544
                                -> AbiHash
545 546 547
                                -> Library
                                -> LocalBuildInfo
                                -> ComponentLocalBuildInfo
548
                                -> FilePath
549
                                -> InstalledPackageInfo
550
relocatableInstalledPackageInfo pkg abi_hash lib lbi clbi pkgroot =
551
    generalInstalledPackageInfo adjustReativeIncludeDirs
552
                                pkg abi_hash lib lbi clbi installDirs
553 554 555 556 557 558 559
  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 _
      | null (installIncludes bi) = []
      | otherwise                 = [includedir installDirs]
    bi = libBuildInfo lib
560 561

    installDirs = fmap (("${pkgroot}" </>) . shortRelativePath pkgroot)
562
                $ absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest
563

simonmar's avatar
simonmar committed
564 565
-- -----------------------------------------------------------------------------
-- Unregistration
566

ijones's avatar
ijones committed
567
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
Duncan Coutts's avatar
Duncan Coutts committed
568 569 570
unregister pkg lbi regFlags = do
  let pkgid     = packageId pkg
      genScript = fromFlag (regGenScript regFlags)
571
      verbosity = fromFlag (regVerbosity regFlags)
Duncan Coutts's avatar
Duncan Coutts committed
572
      packageDb = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))
573
                                    (regPackageDB regFlags)
574 575 576 577 578 579 580
      unreg hpi =
        let invocation = HcPkg.unregisterInvocation
                           hpi Verbosity.normal packageDb pkgid
        in if genScript
             then writeFileAtomic unregScriptFileName
                    (BS.Char8.pack $ invocationAsSystemScript buildOS invocation)
             else runProgramInvocation verbosity invocation
Duncan Coutts's avatar
Duncan Coutts committed
581
  setupMessage verbosity "Unregistering" pkgid
582
  withHcPkg verbosity "unregistering is only implemented for GHC and GHCJS"
583
    (compiler lbi) (withPrograms lbi) unreg
ijones's avatar
ijones committed
584

Duncan Coutts's avatar
Duncan Coutts committed
585 586 587 588
unregScriptFileName :: FilePath
unregScriptFileName = case buildOS of
                          Windows -> "unregister.bat"
                          _       -> "unregister.sh"
589 590 591 592 593 594

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