{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Functions for the GHC package database.


module Stack.GhcPkg
  ( createDatabase
  , findGhcPkgField
  , getGlobalDB
  , ghcPkg
  , ghcPkgPathEnvVar
  , mkGhcPackagePath
  , unregisterGhcPkgIds
  ) where

import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           GHC.Utils.GhcPkg.Main.Compat ( ghcPkgUnregisterForce )
import           Path ( (</>), parent )
import           Path.Extra ( toFilePathNoTrailingSep )
import           Path.IO
                   ( doesDirExist, doesFileExist, ensureDir, resolveDir' )
import           RIO.Process ( HasProcessContext, proc, readProcess_ )
import           Stack.Constants ( relFilePackageCache )
import           Stack.Prelude
import           Stack.Types.Compiler ( WhichCompiler (..) )
import           Stack.Types.CompilerPaths
                   ( CompilerPaths (..), GhcPkgExe (..), HasCompiler
                   , compilerPathsL
                   )
import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
import           System.FilePath ( searchPathSeparator )

-- | Get the global package database

getGlobalDB ::
     (HasProcessContext env, HasTerm env)
  => GhcPkgExe
  -> RIO env (Path Abs Dir)
getGlobalDB :: forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe -> RIO env (Path Abs Dir)
getGlobalDB GhcPkgExe
pkgexe = do
  Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Getting global package database location"
  -- This seems like a strange way to get the global package database

  -- location, but I don't know of a better one

  ByteString
bs <- GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
ghcPkg GhcPkgExe
pkgexe [] [String
"list", String
"--global"] RIO env (Either SomeException ByteString)
-> (Either SomeException ByteString -> RIO env ByteString)
-> RIO env ByteString
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> RIO env ByteString)
-> (ByteString -> RIO env ByteString)
-> Either SomeException ByteString
-> RIO env ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> RIO env ByteString
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ByteString -> RIO env ByteString
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  let fp :: String
fp = ByteString -> String
S8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripTrailingColon (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
firstLine ByteString
bs
  IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> RIO env (Path Abs Dir))
-> IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ String -> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs Dir)
resolveDir' String
fp
 where
  stripTrailingColon :: ByteString -> ByteString
stripTrailingColon ByteString
bs
    | ByteString -> Bool
S8.null ByteString
bs = ByteString
bs
    | ByteString -> Char
S8.last ByteString
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
S8.init ByteString
bs
    | Bool
otherwise = ByteString
bs
  firstLine :: ByteString -> ByteString
firstLine = (Char -> Bool) -> ByteString -> ByteString
S8.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')

-- | Run the ghc-pkg executable

ghcPkg ::
     (HasProcessContext env, HasTerm env)
  => GhcPkgExe
  -> [Path Abs Dir]
  -> [String]
  -> RIO env (Either SomeException S8.ByteString)
ghcPkg :: forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
ghcPkg pkgexe :: GhcPkgExe
pkgexe@(GhcPkgExe Path Abs File
pkgPath) [Path Abs Dir]
pkgDbs [String]
args = do
  Either SomeException ByteString
eres <- RIO env (Either SomeException ByteString)
go
  case Either SomeException ByteString
eres of
    Left SomeException
_ -> do
      (Path Abs Dir -> RIO env ()) -> [Path Abs Dir] -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GhcPkgExe -> Path Abs Dir -> RIO env ()
forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe -> Path Abs Dir -> RIO env ()
createDatabase GhcPkgExe
pkgexe) [Path Abs Dir]
pkgDbs
      RIO env (Either SomeException ByteString)
go
    Right ByteString
_ -> Either SomeException ByteString
-> RIO env (Either SomeException ByteString)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException ByteString
eres
 where
  pkg :: String
pkg = Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
pkgPath
  go :: RIO env (Either SomeException ByteString)
go = RIO env ByteString -> RIO env (Either SomeException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (RIO env ByteString -> RIO env (Either SomeException ByteString))
-> RIO env ByteString -> RIO env (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> RIO env (ByteString, ByteString) -> RIO env ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [String]
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
pkg [String]
args' ProcessConfig () () () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
  args' :: [String]
args' = [Path Abs Dir] -> [String]
packageDbFlags [Path Abs Dir]
pkgDbs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args

-- | Create a package database in the given directory, if it doesn't exist.

createDatabase ::
     (HasProcessContext env, HasTerm env)
  => GhcPkgExe
  -> Path Abs Dir
  -> RIO env ()
createDatabase :: forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe -> Path Abs Dir -> RIO env ()
createDatabase (GhcPkgExe Path Abs File
pkgPath) Path Abs Dir
db = do
  Bool
exists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist (Path Abs Dir
db Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFilePackageCache)
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
    -- ghc-pkg requires that the database directory does not exist

    -- yet. If the directory exists but the package.cache file

    -- does, we're in a corrupted state. Check for that state.

    Bool
dirExists <- Path Abs Dir -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
db
    [String]
args <- if Bool
dirExists
      then do
        [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
          [ String -> StyleDoc
flow String
"The package database located at"
          , Path Abs Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs Dir
db
          , String -> StyleDoc
flow String
"is corrupted. It is missing its"
          , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"package.cache"
          , String -> StyleDoc
flow String
"file. Stack is proceeding with a recache."
          ]
        [String] -> RIO env [String]
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"--package-db", Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
db, String
"recache"]
      else do
        -- Creating the parent doesn't seem necessary, as ghc-pkg

        -- seems to be sufficiently smart. But I don't feel like

        -- finding out it isn't the hard way

        Path Abs Dir -> RIO env ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
db)
        [String] -> RIO env [String]
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"init", Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
db]
    RIO env (ByteString, ByteString) -> RIO env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO env (ByteString, ByteString) -> RIO env ())
-> RIO env (ByteString, ByteString) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
pkgPath) [String]
args ((ProcessConfig () () () -> RIO env (ByteString, ByteString))
 -> RIO env (ByteString, ByteString))
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \ProcessConfig () () ()
pc ->
      RIO env (ByteString, ByteString)
-> RIO env () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
onException (ProcessConfig () () () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_ ProcessConfig () () ()
pc) (RIO env () -> RIO env (ByteString, ByteString))
-> RIO env () -> RIO env (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
        Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$
          Utf8Builder
"Error: [S-9735]\n" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
           Utf8Builder
"Unable to create package database at " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
           String -> Utf8Builder
forall a. IsString a => String -> a
fromString (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
db)

-- | Get the environment variable to use for the package DB paths.

ghcPkgPathEnvVar :: WhichCompiler -> Text
ghcPkgPathEnvVar :: WhichCompiler -> Text
ghcPkgPathEnvVar WhichCompiler
Ghc = Text
"GHC_PACKAGE_PATH"

-- | Get the necessary ghc-pkg flags for setting up the given package database

packageDbFlags :: [Path Abs Dir] -> [String]
packageDbFlags :: [Path Abs Dir] -> [String]
packageDbFlags [Path Abs Dir]
pkgDbs =
    String
"--no-user-package-db"
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Path Abs Dir -> String) -> [Path Abs Dir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Path Abs Dir
x -> String
"--package-db=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
x) [Path Abs Dir]
pkgDbs

-- | Get the value of a field of the package.

findGhcPkgField ::
     (HasProcessContext env, HasTerm env)
  => GhcPkgExe
  -> [Path Abs Dir] -- ^ package databases

  -> String -- ^ package identifier, or GhcPkgId

  -> Text
  -> RIO env (Maybe Text)
findGhcPkgField :: forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir] -> String -> Text -> RIO env (Maybe Text)
findGhcPkgField GhcPkgExe
pkgexe [Path Abs Dir]
pkgDbs String
name Text
field = do
  Either SomeException ByteString
result <-
    GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
ghcPkg
      GhcPkgExe
pkgexe
      [Path Abs Dir]
pkgDbs
      [String
"field", String
"--simple-output", String
name, Text -> String
T.unpack Text
field]
  Maybe Text -> RIO env (Maybe Text)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> RIO env (Maybe Text))
-> Maybe Text -> RIO env (Maybe Text)
forall a b. (a -> b) -> a -> b
$
    case Either SomeException ByteString
result of
      Left{} -> Maybe Text
forall a. Maybe a
Nothing
      Right ByteString
bs ->
        (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
stripCR (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8) (Maybe ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
S8.lines ByteString
bs

-- | unregister list of package ghcids, batching available from GHC 8.2.1,

-- see https://github.com/commercialhaskell/stack/issues/2662#issuecomment-460342402

-- using GHC package id where available (from GHC 7.9)

--

-- The version of the ghc-pkg executable supplied with GHCs published before

-- 28 August 2023 does not efficiently bulk unregister. Until an 'efficient'

-- ghc-pkg is available, this function no longer uses:

--

-- >   eres <- ghcPkg pkgexe [pkgDb] args

-- > where

-- >    args = "unregister" : "--user" : "--force" :

-- >      map packageIdentifierString idents ++

-- >      if null gids then [] else "--ipid" : map ghcPkgIdString gids

--

-- but uses:

--

-- >   globalDb <- view $ compilerPathsL.to cpGlobalDB

-- >   eres <- tryAny $ liftIO $

-- >     ghcPkgUnregisterUserForce globalDb pkgDb hasIpid pkgarg_strs

--

unregisterGhcPkgIds ::
     (HasCompiler env, HasProcessContext env, HasTerm env)
  => Bool
     -- ^ Report pretty exceptions as warnings?

  -> GhcPkgExe
  -> Path Abs Dir -- ^ package database

  -> NonEmpty (Either PackageIdentifier GhcPkgId)
  -> RIO env ()
unregisterGhcPkgIds :: forall env.
(HasCompiler env, HasProcessContext env, HasTerm env) =>
Bool
-> GhcPkgExe
-> Path Abs Dir
-> NonEmpty (Either PackageIdentifier GhcPkgId)
-> RIO env ()
unregisterGhcPkgIds Bool
isWarn GhcPkgExe
pkgexe Path Abs Dir
pkgDb NonEmpty (Either PackageIdentifier GhcPkgId)
epgids = do
  Path Abs Dir
globalDb <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs Dir) env (Path Abs Dir)
 -> RIO env (Path Abs Dir))
-> Getting (Path Abs Dir) env (Path Abs Dir)
-> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Getting (Path Abs Dir) env CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter env CompilerPaths
compilerPathsLGetting (Path Abs Dir) env CompilerPaths
-> ((Path Abs Dir -> Const (Path Abs Dir) (Path Abs Dir))
    -> CompilerPaths -> Const (Path Abs Dir) CompilerPaths)
-> Getting (Path Abs Dir) env (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Path Abs Dir)
-> SimpleGetter CompilerPaths (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Path Abs Dir
cpGlobalDB
  Either PrettyException (Either SomeException ByteString)
eres <- RIO env (Either SomeException ByteString)
-> RIO
     env (Either PrettyException (Either SomeException ByteString))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (RIO env (Either SomeException ByteString)
 -> RIO
      env (Either PrettyException (Either SomeException ByteString)))
-> RIO env (Either SomeException ByteString)
-> RIO
     env (Either PrettyException (Either SomeException ByteString))
forall a b. (a -> b) -> a -> b
$ do
    Path Abs Dir -> Path Abs Dir -> Bool -> [String] -> RIO env ()
forall env.
HasTerm env =>
Path Abs Dir -> Path Abs Dir -> Bool -> [String] -> RIO env ()
ghcPkgUnregisterForce Path Abs Dir
globalDb Path Abs Dir
pkgDb Bool
hasIpid [String]
pkgarg_strs
    -- ghcPkgUnregisterForce does not perform an effective

    -- 'ghc-pkg recache', as that depends on a specific version of the Cabal

    -- package.

    GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir]
-> [String]
-> RIO env (Either SomeException ByteString)
ghcPkg GhcPkgExe
pkgexe [Path Abs Dir
pkgDb] [String
"recache"]
  case Either PrettyException (Either SomeException ByteString)
eres of
    Left (PrettyException e
e) -> Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWarn (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
      StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
        StyleDoc
"[S-8729]"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"While unregistering packages, Stack encountered the following \
                \error:"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> e -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty e
e
    Right Either SomeException ByteString
_ -> () -> RIO env ()
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  ([PackageIdentifier]
idents, [GhcPkgId]
gids) = [Either PackageIdentifier GhcPkgId]
-> ([PackageIdentifier], [GhcPkgId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either PackageIdentifier GhcPkgId]
 -> ([PackageIdentifier], [GhcPkgId]))
-> [Either PackageIdentifier GhcPkgId]
-> ([PackageIdentifier], [GhcPkgId])
forall a b. (a -> b) -> a -> b
$ NonEmpty (Either PackageIdentifier GhcPkgId)
-> [Either PackageIdentifier GhcPkgId]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Either PackageIdentifier GhcPkgId)
epgids
  hasIpid :: Bool
hasIpid = Bool -> Bool
not ([GhcPkgId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GhcPkgId]
gids)
  pkgarg_strs :: [String]
pkgarg_strs = (PackageIdentifier -> String) -> [PackageIdentifier] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PackageIdentifier -> String
packageIdentifierString [PackageIdentifier]
idents [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (GhcPkgId -> String) -> [GhcPkgId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GhcPkgId -> String
ghcPkgIdString [GhcPkgId]
gids

-- | Get the value for GHC_PACKAGE_PATH

mkGhcPackagePath :: Bool -> Path Abs Dir -> Path Abs Dir -> [Path Abs Dir] -> Path Abs Dir -> Text
mkGhcPackagePath :: Bool
-> Path Abs Dir
-> Path Abs Dir
-> [Path Abs Dir]
-> Path Abs Dir
-> Text
mkGhcPackagePath Bool
locals Path Abs Dir
localdb Path Abs Dir
deps [Path Abs Dir]
extras Path Abs Dir
globaldb =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char
searchPathSeparator] ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
localdb | Bool
locals]
    , [Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
deps]
    , [Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
db | Path Abs Dir
db <- [Path Abs Dir] -> [Path Abs Dir]
forall a. [a] -> [a]
reverse [Path Abs Dir]
extras]
    , [Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
globaldb]
    ]