Cabal/src/Distribution/Simple/Program/HcPkg.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE OverloadedStrings #-}
   5 {-# LANGUAGE RankNTypes #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Simple.Program.HcPkg
  11 -- Copyright   :  Duncan Coutts 2009, 2013
  12 --
  13 -- Maintainer  :  cabal-devel@haskell.org
  14 -- Portability :  portable
  15 --
  16 -- This module provides an library interface to the @hc-pkg@ program.
  17 -- Currently only GHC and GHCJS have hc-pkg programs.
  18 module Distribution.Simple.Program.HcPkg
  19   ( -- * Types
  20     HcPkgInfo (..)
  21   , RegisterOptions (..)
  22   , defaultRegisterOptions
  23
  24     -- * Actions
  25   , init
  26   , invoke
  27   , register
  28   , unregister
  29   , recache
  30   , expose
  31   , hide
  32   , dump
  33   , describe
  34   , list
  35
  36     -- * Program invocations
  37   , initInvocation
  38   , registerInvocation
  39   , unregisterInvocation
  40   , recacheInvocation
  41   , exposeInvocation
  42   , hideInvocation
  43   , dumpInvocation
  44   , describeInvocation
  45   , listInvocation
  46   ) where
  47
  48 import Distribution.Compat.Prelude hiding (init)
  49 import Prelude ()
  50
  51 import Distribution.InstalledPackageInfo
  52 import Distribution.Parsec
  53 import Distribution.Pretty
  54 import Distribution.Simple.Compiler
  55 import Distribution.Simple.Errors
  56 import Distribution.Simple.Program.Run
  57 import Distribution.Simple.Program.Types
  58 import Distribution.Simple.Utils
  59 import Distribution.Types.ComponentId
  60 import Distribution.Types.PackageId
  61 import Distribution.Types.UnitId
  62 import Distribution.Utils.Path
  63 import Distribution.Verbosity
  64
  65 import Data.List (stripPrefix)
  66 import System.FilePath as FilePath
  67   ( isPathSeparator
  68   , joinPath
  69   , splitDirectories
  70   , splitPath
  71   )
  72
  73 import qualified Data.ByteString as BS
  74 import qualified Data.ByteString.Lazy as LBS
  75 import qualified Data.List.NonEmpty as NE
  76 import qualified System.FilePath.Posix as FilePath.Posix
  77
  78 -- | Information about the features and capabilities of an @hc-pkg@
  79 --   program.
  80 data HcPkgInfo = HcPkgInfo
  81   { hcPkgProgram :: ConfiguredProgram
  82   , noPkgDbStack :: Bool
  83   -- ^ no package DB stack supported
  84   , noVerboseFlag :: Bool
  85   -- ^ hc-pkg does not support verbosity flags
  86   , flagPackageConf :: Bool
  87   -- ^ use package-conf option instead of package-db
  88   , supportsDirDbs :: Bool
  89   -- ^ supports directory style package databases
  90   , requiresDirDbs :: Bool
  91   -- ^ requires directory style package databases
  92   , nativeMultiInstance :: Bool
  93   -- ^ supports --enable-multi-instance flag
  94   , recacheMultiInstance :: Bool
  95   -- ^ supports multi-instance via recache
  96   , suppressFilesCheck :: Bool
  97   -- ^ supports --force-files or equivalent
  98   }
  99
 100 -- | Call @hc-pkg@ to initialise a package database at the location {path}.
 101 --
 102 -- > hc-pkg init {path}
 103 init :: HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
 104 init hpi verbosity preferCompat path
 105   | not (supportsDirDbs hpi)
 106       || (not (requiresDirDbs hpi) && preferCompat) =
 107       writeFile path "[]"
 108   | otherwise =
 109       runProgramInvocation verbosity (initInvocation hpi verbosity path)
 110
 111 -- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
 112 -- provided command-line arguments to it.
 113 invoke
 114   :: HcPkgInfo
 115   -> Verbosity
 116   -> Maybe (SymbolicPath CWD (Dir Pkg))
 117   -> PackageDBStack
 118   -> [String]
 119   -> IO ()
 120 invoke hpi verbosity mbWorkDir dbStack extraArgs =
 121   runProgramInvocation verbosity invocation
 122   where
 123     args = packageDbStackOpts hpi dbStack ++ extraArgs
 124     invocation = programInvocationCwd mbWorkDir (hcPkgProgram hpi) args
 125
 126 -- | Additional variations in the behaviour for 'register'.
 127 data RegisterOptions = RegisterOptions
 128   { registerAllowOverwrite :: Bool
 129   -- ^ Allows re-registering \/ overwriting an existing package
 130   , registerMultiInstance :: Bool
 131   -- ^ Insist on the ability to register multiple instances of a
 132   -- single version of a single package. This will fail if the @hc-pkg@
 133   -- does not support it, see 'nativeMultiInstance' and
 134   -- 'recacheMultiInstance'.
 135   , registerSuppressFilesCheck :: Bool
 136   -- ^ Require that no checks are performed on the existence of package
 137   -- files mentioned in the registration info. This must be used if
 138   -- registering prior to putting the files in their final place. This will
 139   -- fail if the @hc-pkg@ does not support it, see 'suppressFilesCheck'.
 140   }
 141
 142 -- | Defaults are @True@, @False@ and @False@
 143 defaultRegisterOptions :: RegisterOptions
 144 defaultRegisterOptions =
 145   RegisterOptions
 146     { registerAllowOverwrite = True
 147     , registerMultiInstance = False
 148     , registerSuppressFilesCheck = False
 149     }
 150
 151 -- | Call @hc-pkg@ to register a package.
 152 --
 153 -- > hc-pkg register {filename | -} [--user | --global | --package-db]
 154 register
 155   :: HcPkgInfo
 156   -> Verbosity
 157   -> Maybe (SymbolicPath CWD (Dir from))
 158   -> PackageDBStackS from
 159   -> InstalledPackageInfo
 160   -> RegisterOptions
 161   -> IO ()
 162 register hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions
 163   | registerMultiInstance registerOptions
 164   , not (nativeMultiInstance hpi || recacheMultiInstance hpi) =
 165       dieWithException verbosity RegMultipleInstancePkg
 166   | registerSuppressFilesCheck registerOptions
 167   , not (suppressFilesCheck hpi) =
 168       dieWithException verbosity SuppressingChecksOnFile
 169   -- This is a trick. Older versions of GHC do not support the
 170   -- --enable-multi-instance flag for ghc-pkg register but it turns out that
 171   -- the same ability is available by using ghc-pkg recache. The recache
 172   -- command is there to support distro package managers that like to work
 173   -- by just installing files and running update commands, rather than
 174   -- special add/remove commands. So the way to register by this method is
 175   -- to write the package registration file directly into the package db and
 176   -- then call hc-pkg recache.
 177   --
 178   | registerMultiInstance registerOptions
 179   , recacheMultiInstance hpi =
 180       do
 181         let pkgdb = registrationPackageDB packagedbs
 182         writeRegistrationFileDirectly verbosity hpi mbWorkDir pkgdb pkgInfo
 183         recache hpi verbosity mbWorkDir pkgdb
 184   | otherwise =
 185       runProgramInvocation
 186         verbosity
 187         (registerInvocation hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions)
 188
 189 writeRegistrationFileDirectly
 190   :: Verbosity
 191   -> HcPkgInfo
 192   -> Maybe (SymbolicPath CWD (Dir from))
 193   -> PackageDBS from
 194   -> InstalledPackageInfo
 195   -> IO ()
 196 writeRegistrationFileDirectly verbosity hpi mbWorkDir (SpecificPackageDB dir) pkgInfo
 197   | supportsDirDbs hpi =
 198       do
 199         let pkgfile = interpretSymbolicPath mbWorkDir dir </> prettyShow (installedUnitId pkgInfo) <.> "conf"
 200         writeUTF8File pkgfile (showInstalledPackageInfo pkgInfo)
 201   | otherwise =
 202       dieWithException verbosity NoSupportDirStylePackageDb
 203 writeRegistrationFileDirectly verbosity _ _ _ _ =
 204   -- We don't know here what the dir for the global or user dbs are,
 205   -- if that's needed it'll require a bit more plumbing to support.
 206   dieWithException verbosity OnlySupportSpecificPackageDb
 207
 208 -- | Call @hc-pkg@ to unregister a package
 209 --
 210 -- > hc-pkg unregister [pkgid] [--user | --global | --package-db]
 211 unregister :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageId -> IO ()
 212 unregister hpi verbosity mbWorkDir packagedb pkgid =
 213   runProgramInvocation
 214     verbosity
 215     (unregisterInvocation hpi verbosity mbWorkDir packagedb pkgid)
 216
 217 -- | Call @hc-pkg@ to recache the registered packages.
 218 --
 219 -- > hc-pkg recache [--user | --global | --package-db]
 220 recache :: HcPkgInfo -> Verbosity -> Maybe (SymbolicPath CWD (Dir from)) -> PackageDBS from -> IO ()
 221 recache hpi verbosity mbWorkDir packagedb =
 222   runProgramInvocation
 223     verbosity
 224     (recacheInvocation hpi verbosity mbWorkDir packagedb)
 225
 226 -- | Call @hc-pkg@ to expose a package.
 227 --
 228 -- > hc-pkg expose [pkgid] [--user | --global | --package-db]
 229 expose
 230   :: HcPkgInfo
 231   -> Verbosity
 232   -> Maybe (SymbolicPath CWD (Dir Pkg))
 233   -> PackageDB
 234   -> PackageId
 235   -> IO ()
 236 expose hpi verbosity mbWorkDir packagedb pkgid =
 237   runProgramInvocation
 238     verbosity
 239     (exposeInvocation hpi verbosity mbWorkDir packagedb pkgid)
 240
 241 -- | Call @hc-pkg@ to retrieve a specific package
 242 --
 243 -- > hc-pkg describe [pkgid] [--user | --global | --package-db]
 244 describe
 245   :: HcPkgInfo
 246   -> Verbosity
 247   -> Maybe (SymbolicPath CWD (Dir Pkg))
 248   -> PackageDBStack
 249   -> PackageId
 250   -> IO [InstalledPackageInfo]
 251 describe hpi verbosity mbWorkDir packagedb pid = do
 252   output <-
 253     getProgramInvocationLBS
 254       verbosity
 255       (describeInvocation hpi verbosity mbWorkDir packagedb pid)
 256       `catchIO` \_ -> return mempty
 257
 258   case parsePackages output of
 259     Left ok -> return ok
 260     _ -> dieWithException verbosity $ FailedToParseOutputDescribe (programId (hcPkgProgram hpi)) pid
 261
 262 -- | Call @hc-pkg@ to hide a package.
 263 --
 264 -- > hc-pkg hide [pkgid] [--user | --global | --package-db]
 265 hide
 266   :: HcPkgInfo
 267   -> Verbosity
 268   -> Maybe (SymbolicPath CWD (Dir Pkg))
 269   -> PackageDB
 270   -> PackageId
 271   -> IO ()
 272 hide hpi verbosity mbWorkDir packagedb pkgid =
 273   runProgramInvocation
 274     verbosity
 275     (hideInvocation hpi verbosity mbWorkDir packagedb pkgid)
 276
 277 -- | Call @hc-pkg@ to get all the details of all the packages in the given
 278 -- package database.
 279 dump
 280   :: HcPkgInfo
 281   -> Verbosity
 282   -> Maybe (SymbolicPath CWD (Dir from))
 283   -> PackageDBX (SymbolicPath from (Dir PkgDB))
 284   -> IO [InstalledPackageInfo]
 285 dump hpi verbosity mbWorkDir packagedb = do
 286   output <-
 287     getProgramInvocationLBS
 288       verbosity
 289       (dumpInvocation hpi verbosity mbWorkDir packagedb)
 290       `catchIO` \e ->
 291         dieWithException verbosity $ DumpFailed (programId (hcPkgProgram hpi)) (displayException e)
 292
 293   case parsePackages output of
 294     Left ok -> return ok
 295     _ -> dieWithException verbosity $ FailedToParseOutputDump (programId (hcPkgProgram hpi))
 296
 297 parsePackages :: LBS.ByteString -> Either [InstalledPackageInfo] [String]
 298 parsePackages lbs0 =
 299   case traverse parseInstalledPackageInfo $ splitPkgs lbs0 of
 300     Right ok -> Left [setUnitId . maybe id mungePackagePaths (pkgRoot pkg) $ pkg | (_, pkg) <- ok]
 301     Left msgs -> Right (NE.toList msgs)
 302   where
 303     splitPkgs :: LBS.ByteString -> [BS.ByteString]
 304     splitPkgs = checkEmpty . doSplit
 305       where
 306         -- Handle the case of there being no packages at all.
 307         checkEmpty [s] | BS.all isSpace8 s = []
 308         checkEmpty ss = ss
 309
 310         isSpace8 :: Word8 -> Bool
 311         isSpace8 9 = True -- '\t'
 312         isSpace8 10 = True -- '\n'
 313         isSpace8 13 = True -- '\r'
 314         isSpace8 32 = True -- ' '
 315         isSpace8 _ = False
 316
 317         doSplit :: LBS.ByteString -> [BS.ByteString]
 318         doSplit lbs = go (LBS.findIndices (\w -> w == 10 || w == 13) lbs)
 319           where
 320             go :: [Int64] -> [BS.ByteString]
 321             go [] = [LBS.toStrict lbs]
 322             go (idx : idxs) =
 323               let (pfx, sfx) = LBS.splitAt idx lbs
 324                in case foldr (<|>) Nothing $ map (`lbsStripPrefix` sfx) separators of
 325                     Just sfx' -> LBS.toStrict pfx : doSplit sfx'
 326                     Nothing -> go idxs
 327
 328             separators :: [LBS.ByteString]
 329             separators = ["\n---\n", "\r\n---\r\n", "\r---\r"]
 330
 331 lbsStripPrefix :: LBS.ByteString -> LBS.ByteString -> Maybe LBS.ByteString
 332 #if MIN_VERSION_bytestring(0,10,8)
 333 lbsStripPrefix pfx lbs = LBS.stripPrefix pfx lbs
 334 #else
 335 lbsStripPrefix pfx lbs
 336     | LBS.isPrefixOf pfx lbs = Just (LBS.drop (LBS.length pfx) lbs)
 337     | otherwise              = Nothing
 338 #endif
 339
 340 mungePackagePaths :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
 341 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
 342 -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
 343 -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
 344 -- The "pkgroot" is the directory containing the package database.
 345 mungePackagePaths pkgroot pkginfo =
 346   pkginfo
 347     { importDirs = mungePaths (importDirs pkginfo)
 348     , includeDirs = mungePaths (includeDirs pkginfo)
 349     , libraryDirs = mungePaths (libraryDirs pkginfo)
 350     , libraryDirsStatic = mungePaths (libraryDirsStatic pkginfo)
 351     , libraryDynDirs = mungePaths (libraryDynDirs pkginfo)
 352     , frameworkDirs = mungePaths (frameworkDirs pkginfo)
 353     , haddockInterfaces = mungePaths (haddockInterfaces pkginfo)
 354     , haddockHTMLs = mungeUrls (haddockHTMLs pkginfo)
 355     }
 356   where
 357     mungePaths = map mungePath
 358     mungeUrls = map mungeUrl
 359
 360     mungePath p = case stripVarPrefix "${pkgroot}" p of
 361       Just p' -> pkgroot </> p'
 362       Nothing -> p
 363
 364     mungeUrl p = case stripVarPrefix "${pkgrooturl}" p of
 365       Just p' -> toUrlPath pkgroot p'
 366       Nothing -> p
 367
 368     toUrlPath r p =
 369       "file:///"
 370         -- URLs always use posix style '/' separators:
 371         ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
 372
 373     stripVarPrefix var p =
 374       case splitPath p of
 375         (root : path') -> case stripPrefix var root of
 376           Just [sep] | isPathSeparator sep -> Just (joinPath path')
 377           _ -> Nothing
 378         _ -> Nothing
 379
 380 -- Older installed package info files did not have the installedUnitId
 381 -- field, so if it is missing then we fill it as the source package ID.
 382 -- NB: Internal libraries not supported.
 383 setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
 384 setUnitId
 385   pkginfo@InstalledPackageInfo
 386     { installedUnitId = uid
 387     , sourcePackageId = pid
 388     }
 389     | unUnitId uid == "" =
 390         pkginfo
 391           { installedUnitId = mkLegacyUnitId pid
 392           , installedComponentId_ = mkComponentId (prettyShow pid)
 393           }
 394 setUnitId pkginfo = pkginfo
 395
 396 -- | Call @hc-pkg@ to get the source package Id of all the packages in the
 397 -- given package database.
 398 --
 399 -- This is much less information than with 'dump', but also rather quicker.
 400 -- Note in particular that it does not include the 'UnitId', just
 401 -- the source 'PackageId' which is not necessarily unique in any package db.
 402 list
 403   :: HcPkgInfo
 404   -> Verbosity
 405   -> Maybe (SymbolicPath CWD (Dir Pkg))
 406   -> PackageDB
 407   -> IO [PackageId]
 408 list hpi verbosity mbWorkDir packagedb = do
 409   output <-
 410     getProgramInvocationOutput
 411       verbosity
 412       (listInvocation hpi verbosity mbWorkDir packagedb)
 413       `catchIO` \_ -> dieWithException verbosity $ ListFailed (programId (hcPkgProgram hpi))
 414
 415   case parsePackageIds output of
 416     Just ok -> return ok
 417     _ -> dieWithException verbosity $ FailedToParseOutputList (programId (hcPkgProgram hpi))
 418   where
 419     parsePackageIds = traverse simpleParsec . words
 420
 421 --------------------------
 422 -- The program invocations
 423 --
 424
 425 initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
 426 initInvocation hpi verbosity path =
 427   programInvocation (hcPkgProgram hpi) args
 428   where
 429     args =
 430       ["init", path]
 431         ++ verbosityOpts hpi verbosity
 432
 433 registerInvocation
 434   :: HcPkgInfo
 435   -> Verbosity
 436   -> Maybe (SymbolicPath CWD (Dir from))
 437   -> PackageDBStackS from
 438   -> InstalledPackageInfo
 439   -> RegisterOptions
 440   -> ProgramInvocation
 441 registerInvocation hpi verbosity mbWorkDir packagedbs pkgInfo registerOptions =
 442   (programInvocationCwd mbWorkDir (hcPkgProgram hpi) (args "-"))
 443     { progInvokeInput = Just $ IODataText $ showInstalledPackageInfo pkgInfo
 444     , progInvokeInputEncoding = IOEncodingUTF8
 445     }
 446   where
 447     cmdname
 448       | registerAllowOverwrite registerOptions = "update"
 449       | registerMultiInstance registerOptions = "update"
 450       | otherwise = "register"
 451
 452     args file =
 453       [cmdname, file]
 454         ++ packageDbStackOpts hpi packagedbs
 455         ++ [ "--enable-multi-instance"
 456            | registerMultiInstance registerOptions
 457            ]
 458         ++ [ "--force-files"
 459            | registerSuppressFilesCheck registerOptions
 460            ]
 461         ++ verbosityOpts hpi verbosity
 462
 463 unregisterInvocation
 464   :: HcPkgInfo
 465   -> Verbosity
 466   -> Maybe (SymbolicPath CWD (Dir Pkg))
 467   -> PackageDB
 468   -> PackageId
 469   -> ProgramInvocation
 470 unregisterInvocation hpi verbosity mbWorkDir packagedb pkgid =
 471   programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
 472     ["unregister", packageDbOpts hpi packagedb, prettyShow pkgid]
 473       ++ verbosityOpts hpi verbosity
 474
 475 recacheInvocation
 476   :: HcPkgInfo
 477   -> Verbosity
 478   -> Maybe (SymbolicPath CWD (Dir from))
 479   -> PackageDBS from
 480   -> ProgramInvocation
 481 recacheInvocation hpi verbosity mbWorkDir packagedb =
 482   programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
 483     ["recache", packageDbOpts hpi packagedb]
 484       ++ verbosityOpts hpi verbosity
 485
 486 exposeInvocation
 487   :: HcPkgInfo
 488   -> Verbosity
 489   -> Maybe (SymbolicPath CWD (Dir Pkg))
 490   -> PackageDB
 491   -> PackageId
 492   -> ProgramInvocation
 493 exposeInvocation hpi verbosity mbWorkDir packagedb pkgid =
 494   programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
 495     ["expose", packageDbOpts hpi packagedb, prettyShow pkgid]
 496       ++ verbosityOpts hpi verbosity
 497
 498 describeInvocation
 499   :: HcPkgInfo
 500   -> Verbosity
 501   -> Maybe (SymbolicPath CWD (Dir Pkg))
 502   -> PackageDBStack
 503   -> PackageId
 504   -> ProgramInvocation
 505 describeInvocation hpi verbosity mbWorkDir packagedbs pkgid =
 506   programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
 507     ["describe", prettyShow pkgid]
 508       ++ packageDbStackOpts hpi packagedbs
 509       ++ verbosityOpts hpi verbosity
 510
 511 hideInvocation
 512   :: HcPkgInfo
 513   -> Verbosity
 514   -> Maybe (SymbolicPath CWD (Dir Pkg))
 515   -> PackageDB
 516   -> PackageId
 517   -> ProgramInvocation
 518 hideInvocation hpi verbosity mbWorkDir packagedb pkgid =
 519   programInvocationCwd mbWorkDir (hcPkgProgram hpi) $
 520     ["hide", packageDbOpts hpi packagedb, prettyShow pkgid]
 521       ++ verbosityOpts hpi verbosity
 522
 523 dumpInvocation
 524   :: HcPkgInfo
 525   -> Verbosity
 526   -> Maybe (SymbolicPath CWD (Dir from))
 527   -> PackageDBX (SymbolicPath from (Dir PkgDB))
 528   -> ProgramInvocation
 529 dumpInvocation hpi _verbosity mbWorkDir packagedb =
 530   (programInvocationCwd mbWorkDir (hcPkgProgram hpi) args)
 531     { progInvokeOutputEncoding = IOEncodingUTF8
 532     }
 533   where
 534     args =
 535       ["dump", packageDbOpts hpi packagedb]
 536         ++ verbosityOpts hpi silent
 537
 538 -- We use verbosity level 'silent' because it is important that we
 539 -- do not contaminate the output with info/debug messages.
 540
 541 listInvocation
 542   :: HcPkgInfo
 543   -> Verbosity
 544   -> Maybe (SymbolicPath CWD (Dir Pkg))
 545   -> PackageDB
 546   -> ProgramInvocation
 547 listInvocation hpi _verbosity mbWorkDir packagedb =
 548   (programInvocationCwd mbWorkDir (hcPkgProgram hpi) args)
 549     { progInvokeOutputEncoding = IOEncodingUTF8
 550     }
 551   where
 552     args =
 553       ["list", "--simple-output", packageDbOpts hpi packagedb]
 554         ++ verbosityOpts hpi silent
 555
 556 -- We use verbosity level 'silent' because it is important that we
 557 -- do not contaminate the output with info/debug messages.
 558
 559 packageDbStackOpts :: HcPkgInfo -> PackageDBStackS from -> [String]
 560 packageDbStackOpts hpi dbstack
 561   | noPkgDbStack hpi = [packageDbOpts hpi (registrationPackageDB dbstack)]
 562   | otherwise = case dbstack of
 563       (GlobalPackageDB : UserPackageDB : dbs) ->
 564         "--global"
 565           : "--user"
 566           : map specific dbs
 567       (GlobalPackageDB : dbs) ->
 568         "--global"
 569           : ("--no-user-" ++ packageDbFlag hpi)
 570           : map specific dbs
 571       _ -> ierror
 572   where
 573     specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ interpretSymbolicPathCWD db
 574     specific _ = ierror
 575     ierror :: a
 576     ierror = error ("internal error: unexpected package db stack: " ++ show dbstack)
 577
 578 packageDbFlag :: HcPkgInfo -> String
 579 packageDbFlag hpi
 580   | flagPackageConf hpi =
 581       "package-conf"
 582   | otherwise =
 583       "package-db"
 584
 585 packageDbOpts :: HcPkgInfo -> PackageDBX (SymbolicPath from (Dir PkgDB)) -> String
 586 packageDbOpts _ GlobalPackageDB = "--global"
 587 packageDbOpts _ UserPackageDB = "--user"
 588 packageDbOpts hpi (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ interpretSymbolicPathCWD db
 589
 590 verbosityOpts :: HcPkgInfo -> Verbosity -> [String]
 591 verbosityOpts hpi v
 592   | noVerboseFlag hpi =
 593       []
 594   | v >= deafening = ["-v2"]
 595   | v == silent = ["-v0"]
 596   | otherwise = []