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

-----------------------------------------------------------------------------
-- |
-- 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.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 {
       -- | Allows re-registering \/ overwriting an existing package
       RegisterOptions -> Bool
registerAllowOverwrite     :: 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
registerMultiInstance      :: 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'.
       RegisterOptions -> Bool
registerSuppressFilesCheck :: Bool
     }

-- | 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 -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"HcPkg.register: the compiler does not support "
       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"registering multiple instances of packages."

  | RegisterOptions -> Bool
registerSuppressFilesCheck RegisterOptions
registerOptions
  , Bool -> Bool
not (HcPkgInfo -> Bool
suppressFilesCheck HcPkgInfo
hpi)
  = Verbosity -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"HcPkg.register: the compiler does not support "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"suppressing checks on files."

    -- 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 -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"HcPkg.writeRegistrationFileDirectly: compiler does not support dir style package dbs"

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 -> [Char] -> IO ()
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"HcPkg.writeRegistrationFileDirectly: only supports SpecificPackageDB for now"


-- | 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 (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 (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
    Either [InstalledPackageInfo] [[Char]]
_       -> Verbosity -> [Char] -> IO [InstalledPackageInfo]
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO [InstalledPackageInfo])
-> [Char] -> IO [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse output of '"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" describe " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"

-- | 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 -> [Char] -> IO ByteString
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" dump failed: "
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 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 (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
    Either [InstalledPackageInfo] [[Char]]
_       -> Verbosity -> [Char] -> IO [InstalledPackageInfo]
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO [InstalledPackageInfo])
-> [Char] -> IO [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse output of '"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" dump'"


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)
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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe ByteString -> Maybe ByteString -> Maybe ByteString
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 :: [[Char]]
importDirs        = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
importDirs  InstalledPackageInfo
pkginfo),
      includeDirs :: [[Char]]
includeDirs       = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
includeDirs InstalledPackageInfo
pkginfo),
      libraryDirs :: [[Char]]
libraryDirs       = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
libraryDirs InstalledPackageInfo
pkginfo),
      libraryDynDirs :: [[Char]]
libraryDynDirs    = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
libraryDynDirs InstalledPackageInfo
pkginfo),
      frameworkDirs :: [[Char]]
frameworkDirs     = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
frameworkDirs InstalledPackageInfo
pkginfo),
      haddockInterfaces :: [[Char]]
haddockInterfaces = [[Char]] -> [[Char]]
mungePaths (InstalledPackageInfo -> [[Char]]
haddockInterfaces InstalledPackageInfo
pkginfo),
      haddockHTMLs :: [[Char]]
haddockHTMLs      = [[Char]] -> [[Char]]
mungeUrls  (InstalledPackageInfo -> [[Char]]
haddockHTMLs InstalledPackageInfo
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 :: UnitId
installedUnitId = PackageId -> UnitId
mkLegacyUnitId PackageId
pid,
                        installedComponentId_ :: ComponentId
installedComponentId_ = [Char] -> ComponentId
mkComponentId (PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
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 -> [Char] -> IO [Char]
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" list failed"

  case [Char] -> Maybe [PackageId]
parsePackageIds [Char]
output of
    Just [PackageId]
ok -> [PackageId] -> IO [PackageId]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageId]
ok
    Maybe [PackageId]
_       -> Verbosity -> [Char] -> IO [PackageId]
forall a. Verbosity -> [Char] -> IO a
die' Verbosity
verbosity ([Char] -> IO [PackageId]) -> [Char] -> IO [PackageId]
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse output of '"
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> [Char]
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" list'"

  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)
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 :: Maybe IOData
progInvokeInput         = IOData -> Maybe IOData
forall a. a -> Maybe a
Just (IOData -> Maybe IOData) -> IOData -> Maybe IOData
forall a b. (a -> b) -> a -> b
$ [Char] -> IOData
IODataText ([Char] -> IOData) -> [Char] -> IOData
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> [Char]
showInstalledPackageInfo InstalledPackageInfo
pkgInfo,
      progInvokeInputEncoding :: IOEncoding
progInvokeInputEncoding = IOEncoding
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 :: IOEncoding
progInvokeOutputEncoding = IOEncoding
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 :: IOEncoding
progInvokeOutputEncoding = IOEncoding
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      = []