{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.HcPkg
-- Copyright   :  Duncan Coutts 2009, 2013
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module provides an library interface to the @hc-pkg@ program.
-- Currently only GHC and GHCJS have hc-pkg programs.
module Distribution.Simple.Program.HcPkg
  ( -- * Types
    HcPkgInfo (..)
  , RegisterOptions (..)
  , defaultRegisterOptions

    -- * Actions
  , init
  , invoke
  , register
  , unregister
  , recache
  , expose
  , hide
  , dump
  , describe
  , list

    -- * Program invocations
  , initInvocation
  , registerInvocation
  , unregisterInvocation
  , recacheInvocation
  , exposeInvocation
  , hideInvocation
  , dumpInvocation
  , describeInvocation
  , listInvocation
  ) where

import Distribution.Compat.Prelude hiding (init)
import Prelude ()

import Distribution.InstalledPackageInfo
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Types.ComponentId
import Distribution.Types.PackageId
import Distribution.Types.UnitId
import Distribution.Verbosity

import Data.List (stripPrefix)
import System.FilePath as FilePath (isPathSeparator, joinPath, splitDirectories, splitPath, (<.>), (</>))

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List.NonEmpty as NE
import qualified System.FilePath.Posix as FilePath.Posix

-- | Information about the features and capabilities of an @hc-pkg@
--   program.
data HcPkgInfo = HcPkgInfo
  { HcPkgInfo -> ConfiguredProgram
hcPkgProgram :: ConfiguredProgram
  , HcPkgInfo -> Bool
noPkgDbStack :: Bool
  -- ^ no package DB stack supported
  , HcPkgInfo -> Bool
noVerboseFlag :: Bool
  -- ^ hc-pkg does not support verbosity flags
  , HcPkgInfo -> Bool
flagPackageConf :: Bool
  -- ^ use package-conf option instead of package-db
  , HcPkgInfo -> Bool
supportsDirDbs :: Bool
  -- ^ supports directory style package databases
  , HcPkgInfo -> Bool
requiresDirDbs :: Bool
  -- ^ requires directory style package databases
  , HcPkgInfo -> Bool
nativeMultiInstance :: Bool
  -- ^ supports --enable-multi-instance flag
  , HcPkgInfo -> Bool
recacheMultiInstance :: Bool
  -- ^ supports multi-instance via recache
  , HcPkgInfo -> Bool
suppressFilesCheck :: Bool
  -- ^ supports --force-files or equivalent
  }

-- | Call @hc-pkg@ to initialise a package database at the location {path}.
--
-- > hc-pkg init {path}
init :: HcPkgInfo -> Verbosity -> Bool -> FilePath -> IO ()
init :: HcPkgInfo -> Verbosity -> Bool -> [Char] -> IO ()
init HcPkgInfo
hpi Verbosity
verbosity Bool
preferCompat [Char]
path
  | Bool -> Bool
not (HcPkgInfo -> Bool
supportsDirDbs HcPkgInfo
hpi)
      Bool -> Bool -> Bool
|| (Bool -> Bool
not (HcPkgInfo -> Bool
requiresDirDbs HcPkgInfo
hpi) Bool -> Bool -> Bool
&& Bool
preferCompat) =
      [Char] -> [Char] -> IO ()
writeFile [Char]
path [Char]
"[]"
  | Bool
otherwise =
      Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (HcPkgInfo -> Verbosity -> [Char] -> ProgramInvocation
initInvocation HcPkgInfo
hpi Verbosity
verbosity [Char]
path)

-- | Run @hc-pkg@ using a given package DB stack, directly forwarding the
-- provided command-line arguments to it.
invoke :: HcPkgInfo -> Verbosity -> PackageDBStack -> [String] -> IO ()
invoke :: HcPkgInfo -> Verbosity -> PackageDBStack -> [[Char]] -> IO ()
invoke HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
dbStack [[Char]]
extraArgs =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
invocation
  where
    args :: [[Char]]
args = HcPkgInfo -> PackageDBStack -> [[Char]]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
dbStack [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
extraArgs
    invocation :: ProgramInvocation
invocation = ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [[Char]]
args

-- | Additional variations in the behaviour for 'register'.
data RegisterOptions = RegisterOptions
  { RegisterOptions -> Bool
registerAllowOverwrite :: Bool
  -- ^ Allows re-registering \/ overwriting an existing package
  , RegisterOptions -> Bool
registerMultiInstance :: Bool
  -- ^ Insist on the ability to register multiple instances of a
  -- single version of a single package. This will fail if the @hc-pkg@
  -- does not support it, see 'nativeMultiInstance' and
  -- 'recacheMultiInstance'.
  , RegisterOptions -> Bool
registerSuppressFilesCheck :: Bool
  -- ^ Require that no checks are performed on the existence of package
  -- files mentioned in the registration info. This must be used if
  -- registering prior to putting the files in their final place. This will
  -- fail if the @hc-pkg@ does not support it, see 'suppressFilesCheck'.
  }

-- | Defaults are @True@, @False@ and @False@
defaultRegisterOptions :: RegisterOptions
defaultRegisterOptions :: RegisterOptions
defaultRegisterOptions =
  RegisterOptions
    { registerAllowOverwrite :: Bool
registerAllowOverwrite = Bool
True
    , registerMultiInstance :: Bool
registerMultiInstance = Bool
False
    , registerSuppressFilesCheck :: Bool
registerSuppressFilesCheck = Bool
False
    }

-- | Call @hc-pkg@ to register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
register
  :: HcPkgInfo
  -> Verbosity
  -> PackageDBStack
  -> InstalledPackageInfo
  -> RegisterOptions
  -> IO ()
register :: HcPkgInfo
-> Verbosity
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
register HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedbs InstalledPackageInfo
pkgInfo RegisterOptions
registerOptions
  | RegisterOptions -> Bool
registerMultiInstance RegisterOptions
registerOptions
  , Bool -> Bool
not (HcPkgInfo -> Bool
nativeMultiInstance HcPkgInfo
hpi Bool -> Bool -> Bool
|| HcPkgInfo -> Bool
recacheMultiInstance HcPkgInfo
hpi) =
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
RegMultipleInstancePkg
  | RegisterOptions -> Bool
registerSuppressFilesCheck RegisterOptions
registerOptions
  , Bool -> Bool
not (HcPkgInfo -> Bool
suppressFilesCheck HcPkgInfo
hpi) =
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
SuppressingChecksOnFile
  -- This is a trick. Older versions of GHC do not support the
  -- --enable-multi-instance flag for ghc-pkg register but it turns out that
  -- the same ability is available by using ghc-pkg recache. The recache
  -- command is there to support distro package managers that like to work
  -- by just installing files and running update commands, rather than
  -- special add/remove commands. So the way to register by this method is
  -- to write the package registration file directly into the package db and
  -- then call hc-pkg recache.
  --
  | RegisterOptions -> Bool
registerMultiInstance RegisterOptions
registerOptions
  , HcPkgInfo -> Bool
recacheMultiInstance HcPkgInfo
hpi =
      do
        let pkgdb :: PackageDB
pkgdb = PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
packagedbs
        Verbosity
-> HcPkgInfo -> PackageDB -> InstalledPackageInfo -> IO ()
writeRegistrationFileDirectly Verbosity
verbosity HcPkgInfo
hpi PackageDB
pkgdb InstalledPackageInfo
pkgInfo
        HcPkgInfo -> Verbosity -> PackageDB -> IO ()
recache HcPkgInfo
hpi Verbosity
verbosity PackageDB
pkgdb
  | Bool
otherwise =
      Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
        Verbosity
verbosity
        (HcPkgInfo
-> Verbosity
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
registerInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedbs InstalledPackageInfo
pkgInfo RegisterOptions
registerOptions)

writeRegistrationFileDirectly
  :: Verbosity
  -> HcPkgInfo
  -> PackageDB
  -> InstalledPackageInfo
  -> IO ()
writeRegistrationFileDirectly :: Verbosity
-> HcPkgInfo -> PackageDB -> InstalledPackageInfo -> IO ()
writeRegistrationFileDirectly Verbosity
verbosity HcPkgInfo
hpi (SpecificPackageDB [Char]
dir) InstalledPackageInfo
pkgInfo
  | HcPkgInfo -> Bool
supportsDirDbs HcPkgInfo
hpi =
      do
        let pkgfile :: [Char]
pkgfile = [Char]
dir [Char] -> [Char] -> [Char]
</> UnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
pkgInfo) [Char] -> [Char] -> [Char]
<.> [Char]
"conf"
        [Char] -> [Char] -> IO ()
writeUTF8File [Char]
pkgfile (InstalledPackageInfo -> [Char]
showInstalledPackageInfo InstalledPackageInfo
pkgInfo)
  | Bool
otherwise =
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
NoSupportDirStylePackageDb
writeRegistrationFileDirectly Verbosity
verbosity HcPkgInfo
_ PackageDB
_ InstalledPackageInfo
_ =
  -- We don't know here what the dir for the global or user dbs are,
  -- if that's needed it'll require a bit more plumbing to support.
  Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
OnlySupportSpecificPackageDb

-- | Call @hc-pkg@ to unregister a package
--
-- > hc-pkg unregister [pkgid] [--user | --global | --package-db]
unregister :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
unregister :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
unregister HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
    Verbosity
verbosity
    (HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
unregisterInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid)

-- | Call @hc-pkg@ to recache the registered packages.
--
-- > hc-pkg recache [--user | --global | --package-db]
recache :: HcPkgInfo -> Verbosity -> PackageDB -> IO ()
recache :: HcPkgInfo -> Verbosity -> PackageDB -> IO ()
recache HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
    Verbosity
verbosity
    (HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
recacheInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb)

-- | Call @hc-pkg@ to expose a package.
--
-- > hc-pkg expose [pkgid] [--user | --global | --package-db]
expose :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
expose :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
expose HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
    Verbosity
verbosity
    (HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
exposeInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid)

-- | Call @hc-pkg@ to retrieve a specific package
--
-- > hc-pkg describe [pkgid] [--user | --global | --package-db]
describe :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId -> IO [InstalledPackageInfo]
describe :: HcPkgInfo
-> Verbosity
-> PackageDBStack
-> PackageId
-> IO [InstalledPackageInfo]
describe HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedb PackageId
pid = do
  ByteString
output <-
    Verbosity -> ProgramInvocation -> IO ByteString
getProgramInvocationLBS
      Verbosity
verbosity
      (HcPkgInfo
-> Verbosity -> PackageDBStack -> PackageId -> ProgramInvocation
describeInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedb PackageId
pid)
      IO ByteString -> (IOException -> IO ByteString) -> IO ByteString
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty

  case ByteString -> Either [InstalledPackageInfo] [[Char]]
parsePackages ByteString
output of
    Left [InstalledPackageInfo]
ok -> [InstalledPackageInfo] -> IO [InstalledPackageInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
    Either [InstalledPackageInfo] [[Char]]
_ -> Verbosity -> CabalException -> IO [InstalledPackageInfo]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [InstalledPackageInfo])
-> CabalException -> IO [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> PackageId -> CabalException
FailedToParseOutputDescribe (ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi)) PackageId
pid

-- | Call @hc-pkg@ to hide a package.
--
-- > hc-pkg hide [pkgid] [--user | --global | --package-db]
hide :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
hide :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO ()
hide HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
    Verbosity
verbosity
    (HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
hideInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid)

-- | Call @hc-pkg@ to get all the details of all the packages in the given
-- package database.
dump :: HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
dump :: HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo]
dump HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb = do
  ByteString
output <-
    Verbosity -> ProgramInvocation -> IO ByteString
getProgramInvocationLBS
      Verbosity
verbosity
      (HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb)
      IO ByteString -> (IOException -> IO ByteString) -> IO ByteString
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e ->
        Verbosity -> CabalException -> IO ByteString
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ByteString)
-> CabalException -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CabalException
DumpFailed (ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi)) (IOException -> [Char]
forall e. Exception e => e -> [Char]
displayException IOException
e)

  case ByteString -> Either [InstalledPackageInfo] [[Char]]
parsePackages ByteString
output of
    Left [InstalledPackageInfo]
ok -> [InstalledPackageInfo] -> IO [InstalledPackageInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
    Either [InstalledPackageInfo] [[Char]]
_ -> Verbosity -> CabalException -> IO [InstalledPackageInfo]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [InstalledPackageInfo])
-> CabalException -> IO [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
FailedToParseOutputDump (ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi))

parsePackages :: LBS.ByteString -> Either [InstalledPackageInfo] [String]
parsePackages :: ByteString -> Either [InstalledPackageInfo] [[Char]]
parsePackages ByteString
lbs0 =
  case (ByteString
 -> Either (NonEmpty [Char]) ([[Char]], InstalledPackageInfo))
-> [ByteString]
-> Either (NonEmpty [Char]) [([[Char]], InstalledPackageInfo)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ByteString
-> Either (NonEmpty [Char]) ([[Char]], InstalledPackageInfo)
parseInstalledPackageInfo ([ByteString]
 -> Either (NonEmpty [Char]) [([[Char]], InstalledPackageInfo)])
-> [ByteString]
-> Either (NonEmpty [Char]) [([[Char]], InstalledPackageInfo)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
splitPkgs ByteString
lbs0 of
    Right [([[Char]], InstalledPackageInfo)]
ok -> [InstalledPackageInfo] -> Either [InstalledPackageInfo] [[Char]]
forall a b. a -> Either a b
Left [InstalledPackageInfo -> InstalledPackageInfo
setUnitId (InstalledPackageInfo -> InstalledPackageInfo)
-> (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo
-> InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> InstalledPackageInfo)
-> ([Char] -> InstalledPackageInfo -> InstalledPackageInfo)
-> Maybe [Char]
-> InstalledPackageInfo
-> InstalledPackageInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstalledPackageInfo -> InstalledPackageInfo
forall a. a -> a
id [Char] -> InstalledPackageInfo -> InstalledPackageInfo
mungePackagePaths (InstalledPackageInfo -> Maybe [Char]
pkgRoot InstalledPackageInfo
pkg) (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo -> InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo
pkg | ([[Char]]
_, InstalledPackageInfo
pkg) <- [([[Char]], InstalledPackageInfo)]
ok]
    Left NonEmpty [Char]
msgs -> [[Char]] -> Either [InstalledPackageInfo] [[Char]]
forall a b. b -> Either a b
Right (NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty [Char]
msgs)
  where
    splitPkgs :: LBS.ByteString -> [BS.ByteString]
    splitPkgs :: ByteString -> [ByteString]
splitPkgs = [ByteString] -> [ByteString]
checkEmpty ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
doSplit
      where
        -- Handle the case of there being no packages at all.
        checkEmpty :: [ByteString] -> [ByteString]
checkEmpty [ByteString
s] | (Word8 -> Bool) -> ByteString -> Bool
BS.all Word8 -> Bool
isSpace8 ByteString
s = []
        checkEmpty [ByteString]
ss = [ByteString]
ss

        isSpace8 :: Word8 -> Bool
        isSpace8 :: Word8 -> Bool
isSpace8 Word8
9 = Bool
True -- '\t'
        isSpace8 Word8
10 = Bool
True -- '\n'
        isSpace8 Word8
13 = Bool
True -- '\r'
        isSpace8 Word8
32 = Bool
True -- ' '
        isSpace8 Word8
_ = Bool
False

        doSplit :: LBS.ByteString -> [BS.ByteString]
        doSplit :: ByteString -> [ByteString]
doSplit ByteString
lbs = [Int64] -> [ByteString]
go ((Word8 -> Bool) -> ByteString -> [Int64]
LBS.findIndices (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13) ByteString
lbs)
          where
            go :: [Int64] -> [BS.ByteString]
            go :: [Int64] -> [ByteString]
go [] = [ByteString -> ByteString
LBS.toStrict ByteString
lbs]
            go (Int64
idx : [Int64]
idxs) =
              let (ByteString
pfx, ByteString
sfx) = Int64 -> ByteString -> (ByteString, ByteString)
LBS.splitAt Int64
idx ByteString
lbs
               in case (Maybe ByteString -> Maybe ByteString -> Maybe ByteString)
-> Maybe ByteString -> [Maybe ByteString] -> Maybe ByteString
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe ByteString
forall a. Maybe a
Nothing ([Maybe ByteString] -> Maybe ByteString)
-> [Maybe ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> [ByteString] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> Maybe ByteString
`lbsStripPrefix` ByteString
sfx) [ByteString]
separators of
                    Just ByteString
sfx' -> ByteString -> ByteString
LBS.toStrict ByteString
pfx ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
doSplit ByteString
sfx'
                    Maybe ByteString
Nothing -> [Int64] -> [ByteString]
go [Int64]
idxs

            separators :: [LBS.ByteString]
            separators :: [ByteString]
separators = [ByteString
"\n---\n", ByteString
"\r\n---\r\n", ByteString
"\r---\r"]

lbsStripPrefix :: LBS.ByteString -> LBS.ByteString -> Maybe LBS.ByteString
#if MIN_VERSION_bytestring(0,10,8)
lbsStripPrefix :: ByteString -> ByteString -> Maybe ByteString
lbsStripPrefix ByteString
pfx ByteString
lbs = ByteString -> ByteString -> Maybe ByteString
LBS.stripPrefix ByteString
pfx ByteString
lbs
#else
lbsStripPrefix pfx lbs
    | LBS.isPrefixOf pfx lbs = Just (LBS.drop (LBS.length pfx) lbs)
    | otherwise              = Nothing
#endif

mungePackagePaths :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
-- The "pkgroot" is the directory containing the package database.
mungePackagePaths :: [Char] -> InstalledPackageInfo -> InstalledPackageInfo
mungePackagePaths [Char]
pkgroot InstalledPackageInfo
pkginfo =
  InstalledPackageInfo
pkginfo
    { importDirs = mungePaths (importDirs pkginfo)
    , includeDirs = mungePaths (includeDirs pkginfo)
    , libraryDirs = mungePaths (libraryDirs pkginfo)
    , libraryDirsStatic = mungePaths (libraryDirsStatic pkginfo)
    , libraryDynDirs = mungePaths (libraryDynDirs pkginfo)
    , frameworkDirs = mungePaths (frameworkDirs pkginfo)
    , haddockInterfaces = mungePaths (haddockInterfaces pkginfo)
    , haddockHTMLs = mungeUrls (haddockHTMLs pkginfo)
    }
  where
    mungePaths :: [[Char]] -> [[Char]]
mungePaths = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
mungePath
    mungeUrls :: [[Char]] -> [[Char]]
mungeUrls = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
mungeUrl

    mungePath :: [Char] -> [Char]
mungePath [Char]
p = case [Char] -> [Char] -> Maybe [Char]
stripVarPrefix [Char]
"${pkgroot}" [Char]
p of
      Just [Char]
p' -> [Char]
pkgroot [Char] -> [Char] -> [Char]
</> [Char]
p'
      Maybe [Char]
Nothing -> [Char]
p

    mungeUrl :: [Char] -> [Char]
mungeUrl [Char]
p = case [Char] -> [Char] -> Maybe [Char]
stripVarPrefix [Char]
"${pkgrooturl}" [Char]
p of
      Just [Char]
p' -> [Char] -> [Char] -> [Char]
toUrlPath [Char]
pkgroot [Char]
p'
      Maybe [Char]
Nothing -> [Char]
p

    toUrlPath :: [Char] -> [Char] -> [Char]
toUrlPath [Char]
r [Char]
p =
      [Char]
"file:///"
        -- URLs always use posix style '/' separators:
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
FilePath.Posix.joinPath ([Char]
r [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
FilePath.splitDirectories [Char]
p)

    stripVarPrefix :: [Char] -> [Char] -> Maybe [Char]
stripVarPrefix [Char]
var [Char]
p =
      case [Char] -> [[Char]]
splitPath [Char]
p of
        ([Char]
root : [[Char]]
path') -> case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
var [Char]
root of
          Just [Char
sep] | Char -> Bool
isPathSeparator Char
sep -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([[Char]] -> [Char]
joinPath [[Char]]
path')
          Maybe [Char]
_ -> Maybe [Char]
forall a. Maybe a
Nothing
        [[Char]]
_ -> Maybe [Char]
forall a. Maybe a
Nothing

-- Older installed package info files did not have the installedUnitId
-- field, so if it is missing then we fill it as the source package ID.
-- NB: Internal libraries not supported.
setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
setUnitId
  pkginfo :: InstalledPackageInfo
pkginfo@InstalledPackageInfo
    { installedUnitId :: InstalledPackageInfo -> UnitId
installedUnitId = UnitId
uid
    , sourcePackageId :: InstalledPackageInfo -> PackageId
sourcePackageId = PackageId
pid
    }
    | UnitId -> [Char]
unUnitId UnitId
uid [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" =
        InstalledPackageInfo
pkginfo
          { installedUnitId = mkLegacyUnitId pid
          , installedComponentId_ = mkComponentId (prettyShow pid)
          }
setUnitId InstalledPackageInfo
pkginfo = InstalledPackageInfo
pkginfo

-- | Call @hc-pkg@ to get the source package Id of all the packages in the
-- given package database.
--
-- This is much less information than with 'dump', but also rather quicker.
-- Note in particular that it does not include the 'UnitId', just
-- the source 'PackageId' which is not necessarily unique in any package db.
list
  :: HcPkgInfo
  -> Verbosity
  -> PackageDB
  -> IO [PackageId]
list :: HcPkgInfo -> Verbosity -> PackageDB -> IO [PackageId]
list HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb = do
  [Char]
output <-
    Verbosity -> ProgramInvocation -> IO [Char]
getProgramInvocationOutput
      Verbosity
verbosity
      (HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
listInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb)
      IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> Verbosity -> CabalException -> IO [Char]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [Char]) -> CabalException -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
ListFailed (ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi))

  case [Char] -> Maybe [PackageId]
parsePackageIds [Char]
output of
    Just [PackageId]
ok -> [PackageId] -> IO [PackageId]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageId]
ok
    Maybe [PackageId]
_ -> Verbosity -> CabalException -> IO [PackageId]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO [PackageId])
-> CabalException -> IO [PackageId]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
FailedToParseOutputList (ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi))
  where
    parsePackageIds :: [Char] -> Maybe [PackageId]
parsePackageIds = ([Char] -> Maybe PackageId) -> [[Char]] -> Maybe [PackageId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Char] -> Maybe PackageId
forall a. Parsec a => [Char] -> Maybe a
simpleParsec ([[Char]] -> Maybe [PackageId])
-> ([Char] -> [[Char]]) -> [Char] -> Maybe [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words

--------------------------
-- The program invocations
--

initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
initInvocation :: HcPkgInfo -> Verbosity -> [Char] -> ProgramInvocation
initInvocation HcPkgInfo
hpi Verbosity
verbosity [Char]
path =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [[Char]]
args
  where
    args :: [[Char]]
args =
      [[Char]
"init", [Char]
path]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

registerInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDBStack
  -> InstalledPackageInfo
  -> RegisterOptions
  -> ProgramInvocation
registerInvocation :: HcPkgInfo
-> Verbosity
-> PackageDBStack
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
registerInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedbs InstalledPackageInfo
pkgInfo RegisterOptions
registerOptions =
  (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([Char] -> [[Char]]
args [Char]
"-"))
    { progInvokeInput = Just $ IODataText $ showInstalledPackageInfo pkgInfo
    , progInvokeInputEncoding = IOEncodingUTF8
    }
  where
    cmdname :: [Char]
cmdname
      | RegisterOptions -> Bool
registerAllowOverwrite RegisterOptions
registerOptions = [Char]
"update"
      | RegisterOptions -> Bool
registerMultiInstance RegisterOptions
registerOptions = [Char]
"update"
      | Bool
otherwise = [Char]
"register"

    args :: [Char] -> [[Char]]
args [Char]
file =
      [[Char]
cmdname, [Char]
file]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> PackageDBStack -> [[Char]]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
packagedbs
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--enable-multi-instance"
           | RegisterOptions -> Bool
registerMultiInstance RegisterOptions
registerOptions
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
"--force-files"
           | RegisterOptions -> Bool
registerSuppressFilesCheck RegisterOptions
registerOptions
           ]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

unregisterInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDB
  -> PackageId
  -> ProgramInvocation
unregisterInvocation :: HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
unregisterInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([[Char]] -> ProgramInvocation) -> [[Char]] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[Char]
"unregister", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

recacheInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDB
  -> ProgramInvocation
recacheInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
recacheInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([[Char]] -> ProgramInvocation) -> [[Char]] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[Char]
"recache", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

exposeInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDB
  -> PackageId
  -> ProgramInvocation
exposeInvocation :: HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
exposeInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([[Char]] -> ProgramInvocation) -> [[Char]] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[Char]
"expose", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

describeInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDBStack
  -> PackageId
  -> ProgramInvocation
describeInvocation :: HcPkgInfo
-> Verbosity -> PackageDBStack -> PackageId -> ProgramInvocation
describeInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
packagedbs PackageId
pkgid =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([[Char]] -> ProgramInvocation) -> [[Char]] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[Char]
"describe", PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> PackageDBStack -> [[Char]]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
packagedbs
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

hideInvocation
  :: HcPkgInfo
  -> Verbosity
  -> PackageDB
  -> PackageId
  -> ProgramInvocation
hideInvocation :: HcPkgInfo
-> Verbosity -> PackageDB -> PackageId -> ProgramInvocation
hideInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb PackageId
pkgid =
  ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([[Char]] -> ProgramInvocation) -> [[Char]] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[Char]
"hide", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid]
      [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity

dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation HcPkgInfo
hpi Verbosity
_verbosity PackageDB
packagedb =
  (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [[Char]]
args)
    { progInvokeOutputEncoding = IOEncodingUTF8
    }
  where
    args :: [[Char]]
args =
      [[Char]
"dump", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
silent

-- We use verbosity level 'silent' because it is important that we
-- do not contaminate the output with info/debug messages.

listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
listInvocation HcPkgInfo
hpi Verbosity
_verbosity PackageDB
packagedb =
  (ConfiguredProgram -> [[Char]] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [[Char]]
args)
    { progInvokeOutputEncoding = IOEncodingUTF8
    }
  where
    args :: [[Char]]
args =
      [[Char]
"list", [Char]
"--simple-output", HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
silent

-- We use verbosity level 'silent' because it is important that we
-- do not contaminate the output with info/debug messages.

packageDbStackOpts :: HcPkgInfo -> PackageDBStack -> [String]
packageDbStackOpts :: HcPkgInfo -> PackageDBStack -> [[Char]]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
dbstack
  | HcPkgInfo -> Bool
noPkgDbStack HcPkgInfo
hpi = [HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
hpi (PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
dbstack)]
  | Bool
otherwise = case PackageDBStack
dbstack of
      (PackageDB
GlobalPackageDB : PackageDB
UserPackageDB : PackageDBStack
dbs) ->
        [Char]
"--global"
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"--user"
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (PackageDB -> [Char]) -> PackageDBStack -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> [Char]
specific PackageDBStack
dbs
      (PackageDB
GlobalPackageDB : PackageDBStack
dbs) ->
        [Char]
"--global"
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char]
"--no-user-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> [Char]
packageDbFlag HcPkgInfo
hpi)
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (PackageDB -> [Char]) -> PackageDBStack -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> [Char]
specific PackageDBStack
dbs
      PackageDBStack
_ -> [[Char]]
forall a. a
ierror
  where
    specific :: PackageDB -> [Char]
specific (SpecificPackageDB [Char]
db) = [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> [Char]
packageDbFlag HcPkgInfo
hpi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
db
    specific PackageDB
_ = [Char]
forall a. a
ierror
    ierror :: a
    ierror :: forall a. a
ierror = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"internal error: unexpected package db stack: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageDBStack -> [Char]
forall a. Show a => a -> [Char]
show PackageDBStack
dbstack)

packageDbFlag :: HcPkgInfo -> String
packageDbFlag :: HcPkgInfo -> [Char]
packageDbFlag HcPkgInfo
hpi
  | HcPkgInfo -> Bool
flagPackageConf HcPkgInfo
hpi =
      [Char]
"package-conf"
  | Bool
otherwise =
      [Char]
"package-db"

packageDbOpts :: HcPkgInfo -> PackageDB -> String
packageDbOpts :: HcPkgInfo -> PackageDB -> [Char]
packageDbOpts HcPkgInfo
_ PackageDB
GlobalPackageDB = [Char]
"--global"
packageDbOpts HcPkgInfo
_ PackageDB
UserPackageDB = [Char]
"--user"
packageDbOpts HcPkgInfo
hpi (SpecificPackageDB [Char]
db) = [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> [Char]
packageDbFlag HcPkgInfo
hpi [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
db

verbosityOpts :: HcPkgInfo -> Verbosity -> [String]
verbosityOpts :: HcPkgInfo -> Verbosity -> [[Char]]
verbosityOpts HcPkgInfo
hpi Verbosity
v
  | HcPkgInfo -> Bool
noVerboseFlag HcPkgInfo
hpi =
      []
  | Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
deafening = [[Char]
"-v2"]
  | Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
silent = [[Char]
"-v0"]
  | Bool
otherwise = []