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
    generateRegistrationInfo,
Duncan Coutts's avatar
Duncan Coutts committed
44 45 46
    inplaceInstalledPackageInfo,
    absoluteInstalledPackageInfo,
    generalInstalledPackageInfo,
47
  ) where
48

49 50 51
import Prelude ()
import Distribution.Compat.Prelude

52 53
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
54
import Distribution.Types.ComponentLocalBuildInfo
55

56
import Distribution.Simple.LocalBuildInfo
57
import Distribution.Simple.BuildPaths
58
import Distribution.Simple.BuildTarget
59 60 61 62 63

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
64
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
65
import qualified Distribution.Simple.PackageIndex as Index
66

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

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

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

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

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

    -- It's important to register in build order, because ghc-pkg
    -- will complain if a dependency is not registered.
111 112 113 114 115 116 117 118 119 120 121 122 123 124
    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)
125 126
   where
    verbosity = fromFlag (regVerbosity flags)
127 128 129 130 131

generateOne :: PackageDescription -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo
            -> RegisterFlags
            -> IO InstalledPackageInfo
generateOne pkg lib lbi clbi regFlags
132
  = do
133
    absPackageDBs    <- absolutePackageDBPaths packageDbs
134
    installedPkgInfo <- generateRegistrationInfo
135
                           verbosity pkg lib lbi clbi inplace reloc distPref
136
                           (registrationPackageDB absPackageDBs)
137
    info verbosity (IPI.showInstalledPackageInfo installedPkgInfo)
138 139 140 141 142 143 144 145 146 147 148
    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)
149

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

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

  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
181 182 183 184 185
    -- 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
186 187
    verbosity = fromFlag (regVerbosity regFlags)

188 189 190 191 192
    writeRegistrationFileOrDirectory = do
      -- Handles overwriting both directory and file
      deletePackageDB regFile
      case ipis of
        [installedPkgInfo] -> do
193
          info verbosity ("Creating package registration file: " ++ regFile)
194 195
          writeUTF8File regFile (IPI.showInstalledPackageInfo installedPkgInfo)
        _ -> do
196
          info verbosity ("Creating package registration directory: " ++ regFile)
197 198 199 200 201
          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)
202
          for_ (zip ([1..] :: [Int]) ipis) $ \(i, installedPkgInfo) ->
203 204 205 206
            writeUTF8File (regFile </> (number i ++ "-" ++ display (IPI.installedUnitId installedPkgInfo)))
                          (IPI.showInstalledPackageInfo installedPkgInfo)

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


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

Christiaan Baaij's avatar
Christiaan Baaij committed
230 231
  installedPkgInfo <-
    if inplace
232 233 234
      -- 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
235
      then return (inplaceInstalledPackageInfo pwd distPref
236 237 238 239 240 241 242 243
                     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)
244

245

246
  return installedPkgInfo
247

248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
-- | 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)]
           }

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

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

291
-- | Create an empty package DB at the specified location.
292
createPackageDB :: Verbosity -> Compiler -> ProgramDb -> Bool
293 294 295 296 297 298 299 300
                -> 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
301 302
      _              -> die' verbosity $
                              "Distribution.Simple.Register.createPackageDB: "
303 304
                           ++ "not implemented for this compiler"

305
doesPackageDBExist :: FilePath -> NoCallStackIO Bool
306 307 308 309 310 311 312
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

313
deletePackageDB :: FilePath -> NoCallStackIO ()
314 315 316 317 318 319 320
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
321 322 323

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

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

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

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

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

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

383

384 385 386
-- -----------------------------------------------------------------------------
-- Making the InstalledPackageInfo

Duncan Coutts's avatar
Duncan Coutts committed
387 388 389 390 391 392 393
-- | 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
394
  -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
395
  -> Library
396
  -> LocalBuildInfo
Duncan Coutts's avatar
Duncan Coutts committed
397 398 399
  -> ComponentLocalBuildInfo
  -> InstallDirs FilePath
  -> InstalledPackageInfo
400
generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDirs =
401
  IPI.InstalledPackageInfo {
402 403 404
    IPI.sourceMungedPackageId    = MungedPackageId
                              (componentCompatPackageName clbi)
                              (pkgVersion $ packageId pkg),
405
    IPI.installedUnitId    = componentUnitId clbi,
406
    IPI.installedComponentId_ = componentComponentId clbi,
407
    IPI.instantiatedWith   = componentInstantiatedWith clbi,
408
    IPI.sourcePackageName  = if componentLocalName clbi /= CLibName
409 410 411
                                then Just (pkgName (packageId pkg))
                                else Nothing,
    IPI.sourceLibName      = libName lib,
412
    IPI.compatPackageKey   = componentCompatPackageKey clbi,
Duncan Coutts's avatar
Duncan Coutts committed
413 414 415 416 417 418 419
    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,
420
    IPI.synopsis           = synopsis    pkg,
Duncan Coutts's avatar
Duncan Coutts committed
421 422
    IPI.description        = description pkg,
    IPI.category           = category    pkg,
423
    IPI.abiHash            = abi_hash,
424
    IPI.indefinite         = componentIsIndefinite clbi,
Duncan Coutts's avatar
Duncan Coutts committed
425
    IPI.exposed            = libExposed  lib,
426
    IPI.exposedModules     = componentExposedModules clbi,
Duncan Coutts's avatar
Duncan Coutts committed
427
    IPI.hiddenModules      = otherModules bi,
428
    IPI.trusted            = IPI.trusted IPI.emptyInstalledPackageInfo,
Duncan Coutts's avatar
Duncan Coutts committed
429
    IPI.importDirs         = [ libdir installDirs | hasModules ],
Christiaan Baaij's avatar
Christiaan Baaij committed
430 431
    IPI.libraryDirs        = libdirs,
    IPI.libraryDynDirs     = dynlibdirs,
432
    IPI.dataDir            = datadir installDirs,
433
    IPI.hsLibraries        = if hasLibrary
434
                               then [getHSLibraryName (componentUnitId clbi)]
435
                               else [],
Duncan Coutts's avatar
Duncan Coutts committed
436
    IPI.extraLibraries     = extraLibs bi,
437
    IPI.extraGHCiLibraries = extraGHCiLibs bi,
Duncan Coutts's avatar
Duncan Coutts committed
438 439
    IPI.includeDirs        = absinc ++ adjustRelIncDirs relinc,
    IPI.includes           = includes bi,
440 441
    IPI.depends            = depends,
    IPI.abiDepends         = abi_depends,
Duncan Coutts's avatar
Duncan Coutts committed
442 443 444 445 446
    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,
447
    IPI.frameworkDirs      = extraFrameworkDirs bi,
Duncan Coutts's avatar
Duncan Coutts committed
448
    IPI.haddockInterfaces  = [haddockdir installDirs </> haddockName pkg],
449 450
    IPI.haddockHTMLs       = [htmldir installDirs],
    IPI.pkgRoot            = Nothing
Duncan Coutts's avatar
Duncan Coutts committed
451 452 453
  }
  where
    bi = libBuildInfo lib
454 455 456 457 458 459 460 461 462 463
    --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
464
    (absinc, relinc) = partition isAbsolute (includeDirs bi)
465
    hasModules = not $ null (allLibModules lib clbi)
Christiaan Baaij's avatar
Christiaan Baaij committed
466
    comp = compiler lbi
467 468 469 470
    hasLibrary = (hasModules || not (null (cSources bi))
                             || (not (null (jsSources bi)) &&
                                compilerFlavor comp == GHCJS))
               && not (componentIsIndefinite clbi)
Christiaan Baaij's avatar
Christiaan Baaij committed
471 472 473 474 475 476 477 478 479 480 481 482 483 484
    (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
485

Ian D. Bollinger's avatar
Ian D. Bollinger committed
486
-- | Construct 'InstalledPackageInfo' for a library that is in place in the
Duncan Coutts's avatar
Duncan Coutts committed
487 488
-- build tree.
--
Ian D. Bollinger's avatar
Ian D. Bollinger committed
489
-- This function knows about the layout of in place packages.
Duncan Coutts's avatar
Duncan Coutts committed
490 491 492 493
--
inplaceInstalledPackageInfo :: FilePath -- ^ top of the build tree
                            -> FilePath -- ^ location of the dist tree
                            -> PackageDescription
494
                            -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
495 496 497 498
                            -> Library
                            -> LocalBuildInfo
                            -> ComponentLocalBuildInfo
                            -> InstalledPackageInfo
499
inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
500
    generalInstalledPackageInfo adjustRelativeIncludeDirs
501
                                pkg abi_hash lib lbi clbi installDirs
Duncan Coutts's avatar
Duncan Coutts committed
502
  where
refold's avatar
refold committed
503
    adjustRelativeIncludeDirs = map (inplaceDir </>)
504
    libTargetDir = componentBuildDir lbi clbi
Duncan Coutts's avatar
Duncan Coutts committed
505
    installDirs =
506
      (absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest) {
507
        libdir     = inplaceDir </> libTargetDir,
Christiaan Baaij's avatar
Christiaan Baaij committed
508
        dynlibdir  = inplaceDir </> libTargetDir,
509
        datadir    = inplaceDir </> dataDir pkg,
Duncan Coutts's avatar
Duncan Coutts committed
510 511 512 513 514 515 516 517 518 519 520 521 522 523
        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
524
                             -> AbiHash
Duncan Coutts's avatar
Duncan Coutts committed
525 526 527 528
                             -> Library
                             -> LocalBuildInfo
                             -> ComponentLocalBuildInfo
                             -> InstalledPackageInfo
529
absoluteInstalledPackageInfo pkg abi_hash lib lbi clbi =
530
    generalInstalledPackageInfo adjustReativeIncludeDirs
531
                                pkg abi_hash lib lbi clbi installDirs
Duncan Coutts's avatar
Duncan Coutts committed
532 533 534 535 536 537 538
  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
539
    installDirs = absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest
Duncan Coutts's avatar
Duncan Coutts committed
540

541 542

relocatableInstalledPackageInfo :: PackageDescription
543
                                -> AbiHash
544 545 546
                                -> Library
                                -> LocalBuildInfo
                                -> ComponentLocalBuildInfo
547
                                -> FilePath
548
                                -> InstalledPackageInfo
549
relocatableInstalledPackageInfo pkg abi_hash lib lbi clbi pkgroot =
550
    generalInstalledPackageInfo adjustReativeIncludeDirs
551
                                pkg abi_hash lib lbi clbi installDirs
552 553 554 555 556 557 558
  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
559 560

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

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

ijones's avatar
ijones committed
566
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
Duncan Coutts's avatar
Duncan Coutts committed
567 568 569
unregister pkg lbi regFlags = do
  let pkgid     = packageId pkg
      genScript = fromFlag (regGenScript regFlags)
570
      verbosity = fromFlag (regVerbosity regFlags)
Duncan Coutts's avatar
Duncan Coutts committed
571
      packageDb = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))
572
                                    (regPackageDB regFlags)
573 574 575 576 577 578 579
      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
580
  setupMessage verbosity "Unregistering" pkgid
581
  withHcPkg verbosity "unregistering is only implemented for GHC and GHCJS"
582
    (compiler lbi) (withPrograms lbi) unreg
ijones's avatar
ijones committed
583

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

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