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

    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 -> [String]
    extraDBs :: [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)

    -- | 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 -> [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

    -- | Determine the PackageDBs based on the environment.
    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)

    -- | Get the package DB flags for the current GHC version and from the
    -- environment.
    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