{-# 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 -> FilePath -> IO ()
init HcPkgInfo
hpi Verbosity
verbosity Bool
preferCompat FilePath
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)
  = FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
"[]"

  | Bool
otherwise
  = Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
initInvocation HcPkgInfo
hpi Verbosity
verbosity FilePath
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 -> [FilePath] -> IO ()
invoke HcPkgInfo
hpi Verbosity
verbosity PackageDBStack
dbStack [FilePath]
extraArgs =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
invocation
  where
    args :: [FilePath]
args       = HcPkgInfo -> PackageDBStack -> [FilePath]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
dbStack [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extraArgs
    invocation :: ProgramInvocation
invocation = ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [FilePath]
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 :: Bool -> Bool -> Bool -> RegisterOptions
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 -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"HcPkg.register: the compiler does not support "
       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"registering multiple instances of packages."

  | RegisterOptions -> Bool
registerSuppressFilesCheck RegisterOptions
registerOptions
  , Bool -> Bool
not (HcPkgInfo -> Bool
suppressFilesCheck HcPkgInfo
hpi)
  = Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"HcPkg.register: the compiler does not support "
                  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"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 FilePath
dir) InstalledPackageInfo
pkgInfo
  | HcPkgInfo -> Bool
supportsDirDbs HcPkgInfo
hpi
  = do let pkgfile :: FilePath
pkgfile = FilePath
dir FilePath -> FilePath -> FilePath
</> UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (InstalledPackageInfo -> UnitId
installedUnitId InstalledPackageInfo
pkgInfo) FilePath -> FilePath -> FilePath
<.> FilePath
"conf"
       FilePath -> FilePath -> IO ()
writeUTF8File FilePath
pkgfile (InstalledPackageInfo -> FilePath
showInstalledPackageInfo InstalledPackageInfo
pkgInfo)

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

-- | 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 -> FilePath -> IO ByteString
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> FilePath
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" dump failed: "
                       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e

  case ByteString -> Either [InstalledPackageInfo] [FilePath]
parsePackages ByteString
output of
    Left [InstalledPackageInfo]
ok -> [InstalledPackageInfo] -> IO [InstalledPackageInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
    Either [InstalledPackageInfo] [FilePath]
_       -> Verbosity -> FilePath -> IO [InstalledPackageInfo]
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO [InstalledPackageInfo])
-> FilePath -> IO [InstalledPackageInfo]
forall a b. (a -> b) -> a -> b
$ FilePath
"failed to parse output of '"
                  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ConfiguredProgram -> FilePath
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" dump'"


parsePackages :: LBS.ByteString -> Either [InstalledPackageInfo] [String]
parsePackages :: ByteString -> Either [InstalledPackageInfo] [FilePath]
parsePackages ByteString
lbs0 =
    case (ByteString
 -> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo))
-> [ByteString]
-> Either (NonEmpty FilePath) [([FilePath], InstalledPackageInfo)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString
-> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)
parseInstalledPackageInfo ([ByteString]
 -> Either (NonEmpty FilePath) [([FilePath], InstalledPackageInfo)])
-> [ByteString]
-> Either (NonEmpty FilePath) [([FilePath], InstalledPackageInfo)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
splitPkgs ByteString
lbs0 of
        Right [([FilePath], InstalledPackageInfo)]
ok  -> [InstalledPackageInfo] -> Either [InstalledPackageInfo] [FilePath]
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)
-> (FilePath -> InstalledPackageInfo -> InstalledPackageInfo)
-> Maybe FilePath
-> InstalledPackageInfo
-> InstalledPackageInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstalledPackageInfo -> InstalledPackageInfo
forall a. a -> a
id FilePath -> InstalledPackageInfo -> InstalledPackageInfo
mungePackagePaths (InstalledPackageInfo -> Maybe FilePath
pkgRoot InstalledPackageInfo
pkg) (InstalledPackageInfo -> InstalledPackageInfo)
-> InstalledPackageInfo -> InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo
pkg | ([FilePath]
_, InstalledPackageInfo
pkg) <- [([FilePath], InstalledPackageInfo)]
ok ]
        Left NonEmpty FilePath
msgs -> [FilePath] -> Either [InstalledPackageInfo] [FilePath]
forall a b. b -> Either a b
Right (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
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 :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
mungePackagePaths FilePath
pkgroot InstalledPackageInfo
pkginfo =
    InstalledPackageInfo
pkginfo {
      importDirs :: [FilePath]
importDirs        = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
importDirs  InstalledPackageInfo
pkginfo),
      includeDirs :: [FilePath]
includeDirs       = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
includeDirs InstalledPackageInfo
pkginfo),
      libraryDirs :: [FilePath]
libraryDirs       = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
libraryDirs InstalledPackageInfo
pkginfo),
      libraryDynDirs :: [FilePath]
libraryDynDirs    = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
libraryDynDirs InstalledPackageInfo
pkginfo),
      frameworkDirs :: [FilePath]
frameworkDirs     = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
frameworkDirs InstalledPackageInfo
pkginfo),
      haddockInterfaces :: [FilePath]
haddockInterfaces = [FilePath] -> [FilePath]
mungePaths (InstalledPackageInfo -> [FilePath]
haddockInterfaces InstalledPackageInfo
pkginfo),
      haddockHTMLs :: [FilePath]
haddockHTMLs      = [FilePath] -> [FilePath]
mungeUrls  (InstalledPackageInfo -> [FilePath]
haddockHTMLs InstalledPackageInfo
pkginfo)
    }
  where
    mungePaths :: [FilePath] -> [FilePath]
mungePaths = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
mungePath
    mungeUrls :: [FilePath] -> [FilePath]
mungeUrls  = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
mungeUrl

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

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

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

    stripVarPrefix :: FilePath -> FilePath -> Maybe FilePath
stripVarPrefix FilePath
var FilePath
p =
      case FilePath -> [FilePath]
splitPath FilePath
p of
        (FilePath
root:[FilePath]
path') -> case FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
var FilePath
root of
          Just [Char
sep] | Char -> Bool
isPathSeparator Char
sep -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just ([FilePath] -> FilePath
joinPath [FilePath]
path')
          Maybe FilePath
_                                -> Maybe FilePath
forall a. Maybe a
Nothing
        [FilePath]
_                                  -> Maybe FilePath
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 -> FilePath
unUnitId UnitId
uid FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""
                    = InstalledPackageInfo
pkginfo {
                        installedUnitId :: UnitId
installedUnitId = PackageId -> UnitId
mkLegacyUnitId PackageId
pid,
                        installedComponentId_ :: ComponentId
installedComponentId_ = FilePath -> ComponentId
mkComponentId (PackageId -> FilePath
forall a. Pretty a => a -> FilePath
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

  FilePath
output <- Verbosity -> ProgramInvocation -> IO FilePath
getProgramInvocationOutput Verbosity
verbosity
              (HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
listInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb)
    IO FilePath -> (IOException -> IO FilePath) -> IO FilePath
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> Verbosity -> FilePath -> IO FilePath
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> FilePath
programId (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" list failed"

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

  where
    parsePackageIds :: FilePath -> Maybe [PackageId]
parsePackageIds = (FilePath -> Maybe PackageId) -> [FilePath] -> Maybe [PackageId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> Maybe PackageId
forall a. Parsec a => FilePath -> Maybe a
simpleParsec ([FilePath] -> Maybe [PackageId])
-> (FilePath -> [FilePath]) -> FilePath -> Maybe [PackageId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words

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

initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation
initInvocation HcPkgInfo
hpi Verbosity
verbosity FilePath
path =
    ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [FilePath]
args
  where
    args :: [FilePath]
args = [FilePath
"init", FilePath
path]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) (FilePath -> [FilePath]
args FilePath
"-")) {
      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
$ FilePath -> IOData
IODataText (FilePath -> IOData) -> FilePath -> IOData
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> FilePath
showInstalledPackageInfo InstalledPackageInfo
pkgInfo,
      progInvokeInputEncoding :: IOEncoding
progInvokeInputEncoding = IOEncoding
IOEncodingUTF8
    }
  where
    cmdname :: FilePath
cmdname
      | RegisterOptions -> Bool
registerAllowOverwrite RegisterOptions
registerOptions = FilePath
"update"
      | RegisterOptions -> Bool
registerMultiInstance  RegisterOptions
registerOptions = FilePath
"update"
      | Bool
otherwise                              = FilePath
"register"

    args :: FilePath -> [FilePath]
args FilePath
file = [FilePath
cmdname, FilePath
file]
             [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> PackageDBStack -> [FilePath]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
packagedbs
             [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"--enable-multi-instance"
                | RegisterOptions -> Bool
registerMultiInstance RegisterOptions
registerOptions ]
             [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"--force-files"
                | RegisterOptions -> Bool
registerSuppressFilesCheck RegisterOptions
registerOptions ]
             [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
       [FilePath
"unregister", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity


recacheInvocation :: HcPkgInfo -> Verbosity -> PackageDB
                  -> ProgramInvocation
recacheInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
recacheInvocation HcPkgInfo
hpi Verbosity
verbosity PackageDB
packagedb =
  ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
       [FilePath
"recache", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
       [FilePath
"expose", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
       [FilePath
"describe", PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> PackageDBStack -> [FilePath]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
packagedbs
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
       [FilePath
"hide", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb, PackageId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageId
pkgid]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
verbosityOpts HcPkgInfo
hpi Verbosity
verbosity


dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation
dumpInvocation HcPkgInfo
hpi Verbosity
_verbosity PackageDB
packagedb =
    (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [FilePath]
args) {
      progInvokeOutputEncoding :: IOEncoding
progInvokeOutputEncoding = IOEncoding
IOEncodingUTF8
    }
  where
    args :: [FilePath]
args = [FilePath
"dump", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath] -> ProgramInvocation
programInvocation (HcPkgInfo -> ConfiguredProgram
hcPkgProgram HcPkgInfo
hpi) [FilePath]
args) {
      progInvokeOutputEncoding :: IOEncoding
progInvokeOutputEncoding = IOEncoding
IOEncodingUTF8
    }
  where
    args :: [FilePath]
args = [FilePath
"list", FilePath
"--simple-output", HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi PackageDB
packagedb]
        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> Verbosity -> [FilePath]
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 -> [FilePath]
packageDbStackOpts HcPkgInfo
hpi PackageDBStack
dbstack
  | HcPkgInfo -> Bool
noPkgDbStack HcPkgInfo
hpi = [HcPkgInfo -> PackageDB -> FilePath
packageDbOpts HcPkgInfo
hpi (PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
dbstack)]
  | Bool
otherwise        = case PackageDBStack
dbstack of
    (PackageDB
GlobalPackageDB:PackageDB
UserPackageDB:PackageDBStack
dbs) -> FilePath
"--global"
                                         FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
"--user"
                                         FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (PackageDB -> FilePath) -> PackageDBStack -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> FilePath
specific PackageDBStack
dbs
    (PackageDB
GlobalPackageDB:PackageDBStack
dbs)               -> FilePath
"--global"
                                         FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath
"--no-user-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> FilePath
packageDbFlag HcPkgInfo
hpi)
                                         FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (PackageDB -> FilePath) -> PackageDBStack -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PackageDB -> FilePath
specific PackageDBStack
dbs
    PackageDBStack
_                                   -> [FilePath]
forall a. a
ierror
    where
      specific :: PackageDB -> FilePath
specific (SpecificPackageDB FilePath
db) = FilePath
"--" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HcPkgInfo -> FilePath
packageDbFlag HcPkgInfo
hpi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
db
      specific PackageDB
_ = FilePath
forall a. a
ierror
      ierror :: a
      ierror :: a
ierror     = FilePath -> a
forall a. HasCallStack => FilePath -> a
error (FilePath
"internal error: unexpected package db stack: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageDBStack -> FilePath
forall a. Show a => a -> FilePath
show PackageDBStack
dbstack)

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

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

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