{-# LANGUAGE CPP #-}
-- | Manage GHC package databases
module PackageDBs (
  getPackageDBArgs
#ifdef TEST
, PackageDBs (..)
, getPackageDBsFromEnv
#endif
) where

import           Imports

import System.Environment (getEnvironment)
import System.FilePath (splitSearchPath, searchPathSeparator)

-- | Full stack of GHC package databases
data PackageDBs = PackageDBs
    { PackageDBs -> Bool
includeUser :: Bool
    , PackageDBs -> Bool
includeGlobal :: Bool
    , PackageDBs -> [[Char]]
extraDBs :: [FilePath]
    }
    deriving (Int -> PackageDBs -> ShowS
[PackageDBs] -> ShowS
PackageDBs -> [Char]
(Int -> PackageDBs -> ShowS)
-> (PackageDBs -> [Char])
-> ([PackageDBs] -> ShowS)
-> Show PackageDBs
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDBs -> ShowS
showsPrec :: Int -> PackageDBs -> ShowS
$cshow :: PackageDBs -> [Char]
show :: PackageDBs -> [Char]
$cshowList :: [PackageDBs] -> ShowS
showList :: [PackageDBs] -> ShowS
Show, PackageDBs -> PackageDBs -> Bool
(PackageDBs -> PackageDBs -> Bool)
-> (PackageDBs -> PackageDBs -> Bool) -> Eq PackageDBs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDBs -> PackageDBs -> Bool
== :: PackageDBs -> PackageDBs -> Bool
$c/= :: PackageDBs -> PackageDBs -> Bool
/= :: PackageDBs -> PackageDBs -> Bool
Eq)

-- | Determine command line arguments to be passed to GHC to set databases correctly
--
-- >>> dbArgs (PackageDBs False True [])
-- ["-no-user-package-db"]
--
-- >>> dbArgs (PackageDBs True True ["somedb"])
-- ["-package-db","somedb"]
dbArgs :: PackageDBs -> [String]
dbArgs :: PackageDBs -> [[Char]]
dbArgs (PackageDBs Bool
user Bool
global [[Char]]
extras) =
    (if Bool
user then [[Char]] -> [[Char]]
forall a. a -> a
id else ([Char]
"-no-user-package-db"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:)) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
    (if Bool
global then [[Char]] -> [[Char]]
forall a. a -> a
id else ([Char]
"-no-global-package-db"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:)) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
    ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
extra -> [[Char]
"-package-db", [Char]
extra]) [[Char]]
extras

-- | Determine the PackageDBs based on the environment.
getPackageDBsFromEnv :: IO PackageDBs
getPackageDBsFromEnv :: IO PackageDBs
getPackageDBsFromEnv = do
    env <- IO [([Char], [Char])]
getEnvironment
    return $ case () of
        ()
            | Just [Char]
packageDBs <- [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"GHC_PACKAGE_PATH" [([Char], [Char])]
env
                -> [Char] -> PackageDBs
fromEnvMulti [Char]
packageDBs
            | Bool
otherwise
                -> Bool -> Bool -> [[Char]] -> PackageDBs
PackageDBs Bool
True Bool
True []
  where
    fromEnvMulti :: [Char] -> PackageDBs
fromEnvMulti [Char]
s = PackageDBs
        { includeUser :: Bool
includeUser = Bool
False
        , includeGlobal :: Bool
includeGlobal = Bool
global
        , extraDBs :: [[Char]]
extraDBs = [Char] -> [[Char]]
splitSearchPath [Char]
s'
        }
      where
        ([Char]
s', Bool
global) =
            case ShowS
forall a. [a] -> [a]
reverse [Char]
s of
                Char
c:[Char]
rest | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
searchPathSeparator -> (ShowS
forall a. [a] -> [a]
reverse [Char]
rest, Bool
True)
                [Char]
_ -> ([Char]
s, Bool
False)

-- | Get the package DB flags for the current GHC version and from the
-- environment.
getPackageDBArgs :: IO [String]
getPackageDBArgs :: IO [[Char]]
getPackageDBArgs = do
      dbs <- IO PackageDBs
getPackageDBsFromEnv
      return $ dbArgs dbs