{-# LANGUAGE CPP #-}
module PackageDBs (
getPackageDBArgs
#ifdef TEST
, PackageDBs (..)
, getPackageDBsFromEnv
#endif
) where
import Imports
import System.Environment (getEnvironment)
import System.FilePath (splitSearchPath, searchPathSeparator)
data PackageDBs = PackageDBs
{ PackageDBs -> Bool
includeUser :: Bool
, PackageDBs -> Bool
includeGlobal :: Bool
, :: [FilePath]
}
deriving (Int -> PackageDBs -> ShowS
[PackageDBs] -> ShowS
PackageDBs -> String
(Int -> PackageDBs -> ShowS)
-> (PackageDBs -> String)
-> ([PackageDBs] -> ShowS)
-> Show PackageDBs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDBs -> ShowS
showsPrec :: Int -> PackageDBs -> ShowS
$cshow :: PackageDBs -> String
show :: PackageDBs -> String
$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)
dbArgs :: PackageDBs -> [String]
dbArgs :: PackageDBs -> [String]
dbArgs (PackageDBs Bool
user Bool
global [String]
extras) =
(if Bool
user then [String] -> [String]
forall a. a -> a
id else (String
"-no-user-package-db"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(if Bool
global then [String] -> [String]
forall a. a -> a
id else (String
"-no-global-package-db"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
(String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
extra -> [String
"-package-db", String
extra]) [String]
extras
getPackageDBsFromEnv :: IO PackageDBs
getPackageDBsFromEnv :: IO PackageDBs
getPackageDBsFromEnv = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
PackageDBs -> IO PackageDBs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDBs -> IO PackageDBs) -> PackageDBs -> IO PackageDBs
forall a b. (a -> b) -> a -> b
$ case () of
()
| Just String
packageDBs <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"GHC_PACKAGE_PATH" [(String, String)]
env
-> String -> PackageDBs
fromEnvMulti String
packageDBs
| Bool
otherwise
-> Bool -> Bool -> [String] -> PackageDBs
PackageDBs Bool
True Bool
True []
where
fromEnvMulti :: String -> PackageDBs
fromEnvMulti String
s = PackageDBs
{ includeUser :: Bool
includeUser = Bool
False
, includeGlobal :: Bool
includeGlobal = Bool
global
, extraDBs :: [String]
extraDBs = String -> [String]
splitSearchPath String
s'
}
where
(String
s', Bool
global) =
case ShowS
forall a. [a] -> [a]
reverse String
s of
Char
c:String
rest | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
searchPathSeparator -> (ShowS
forall a. [a] -> [a]
reverse String
rest, Bool
True)
String
_ -> (String
s, Bool
False)
getPackageDBArgs :: IO [String]
getPackageDBArgs :: IO [String]
getPackageDBArgs = do
PackageDBs
dbs <- IO PackageDBs
getPackageDBsFromEnv
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ PackageDBs -> [String]
dbArgs PackageDBs
dbs