{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hhp.GHCApi (
    withGHC,
    withGHC',
    initializeFlagsWithCradle,
    setTargetFiles,
    getDynamicFlags,
    getSystemLibDir,
    withDynFlags,
    withCmdFlags,
    setNoWarningFlags,
    setAllWarningFlags,
    setDeferTypedHoles,
    setDeferTypeErrors,
    setPartialSignatures,
    setWarnTypedHoles,
) where

import GHC (DynFlags (..), Ghc, LoadHowMuch (..))
import qualified GHC as G
import qualified GHC.Data.EnumSet as E (EnumSet, empty)
import GHC.Driver.Session (
    GeneralFlag (Opt_BuildingCabalPackage, Opt_HideAllPackages),
    ModRenaming (..),
    PackageArg (..),
    PackageFlag (ExposePackage),
    WarningFlag (Opt_WarnTypedHoles),
    gopt_set,
    parseDynamicFlagsCmdLine,
    wopt_set,
    xopt_set,
 )
import GHC.LanguageExtensions (Extension (..))
import GHC.Utils.Monad (liftIO)

import Control.Applicative ((<|>))
import Control.Monad (forM, void)
import Control.Monad.Catch (SomeException, bracket, handle)
import Data.Maybe (fromJust, isJust)
import System.Exit (exitSuccess)
import System.IO (hPrint, hPutStr, stderr)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess)

import Hhp.CabalApi
import Hhp.Gap
import Hhp.GhcPkg
import Hhp.Types

----------------------------------------------------------------

-- | Obtaining the directory for system libraries.
getSystemLibDir :: IO (Maybe FilePath)
getSystemLibDir :: IO (Maybe FilePath)
getSystemLibDir = do
    FilePath
res <- FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"ghc" [FilePath
"--print-libdir"] []
    Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case FilePath
res of
        FilePath
"" -> Maybe FilePath
forall a. Maybe a
Nothing
        FilePath
dirn -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init FilePath
dirn)

----------------------------------------------------------------

-- | Converting the 'Ghc' monad to the 'IO' monad.
withGHC
    :: FilePath
    -- ^ A target file displayed in an error message.
    -> Ghc a
    -- ^ 'Ghc' actions created by the Ghc utilities.
    -> IO a
withGHC :: forall a. FilePath -> Ghc a -> IO a
withGHC FilePath
file Ghc a
body = (SomeException -> IO a) -> IO a -> IO a
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle SomeException -> IO a
forall a. SomeException -> IO a
ignore (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Ghc a -> IO a
forall a. Ghc a -> IO a
withGHC' Ghc a
body
  where
    ignore :: SomeException -> IO a
    ignore :: forall a. SomeException -> IO a
ignore SomeException
e = do
        Handle -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":0:0:Error:"
        Handle -> SomeException -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
e
        IO a
forall a. IO a
exitSuccess

withGHC' :: Ghc a -> IO a
withGHC' :: forall a. Ghc a -> IO a
withGHC' Ghc a
body = do
    Maybe FilePath
mlibdir <- IO (Maybe FilePath)
getSystemLibDir
    Maybe FilePath -> Ghc a -> IO a
forall a. Maybe FilePath -> Ghc a -> IO a
G.runGhc Maybe FilePath
mlibdir Ghc a
body

----------------------------------------------------------------

importDirs :: [IncludeDir]
importDirs :: [FilePath]
importDirs = [FilePath
".", FilePath
"..", FilePath
"../..", FilePath
"../../..", FilePath
"../../../..", FilePath
"../../../../.."]

data Build = CabalPkg | SingleFile deriving (Build -> Build -> Bool
(Build -> Build -> Bool) -> (Build -> Build -> Bool) -> Eq Build
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Build -> Build -> Bool
== :: Build -> Build -> Bool
$c/= :: Build -> Build -> Bool
/= :: Build -> Build -> Bool
Eq)

-- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
initializeFlagsWithCradle
    :: Options
    -> Cradle
    -> Ghc ()
initializeFlagsWithCradle :: Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    | Bool
cabal = Ghc ()
withCabal Ghc () -> Ghc () -> Ghc ()
forall a. Ghc a -> Ghc a -> Ghc a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Ghc ()
withSandbox
    | Bool
otherwise = Ghc ()
withSandbox
  where
    mCradleFile :: Maybe FilePath
mCradleFile = Cradle -> Maybe FilePath
cradleCabalFile Cradle
cradle
    cabal :: Bool
cabal = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
mCradleFile
    ghcopts :: [FilePath]
ghcopts = Options -> [FilePath]
ghcOpts Options
opt
    withCabal :: Ghc ()
withCabal = do
        PackageDescription
pkgDesc <- IO PackageDescription -> Ghc PackageDescription
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PackageDescription -> Ghc PackageDescription)
-> IO PackageDescription -> Ghc PackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath -> IO PackageDescription
parseCabalFile (FilePath -> IO PackageDescription)
-> FilePath -> IO PackageDescription
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
mCradleFile
        CompilerOptions
compOpts <- IO CompilerOptions -> Ghc CompilerOptions
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompilerOptions -> Ghc CompilerOptions)
-> IO CompilerOptions -> Ghc CompilerOptions
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Cradle -> PackageDescription -> IO CompilerOptions
getCompilerOptions [FilePath]
ghcopts Cradle
cradle PackageDescription
pkgDesc
        Build -> Options -> CompilerOptions -> Ghc ()
initSession Build
CabalPkg Options
opt CompilerOptions
compOpts
    withSandbox :: Ghc ()
withSandbox = Build -> Options -> CompilerOptions -> Ghc ()
initSession Build
SingleFile Options
opt CompilerOptions
compOpts
      where
        pkgOpts :: [FilePath]
pkgOpts = [GhcPkgDb] -> [FilePath]
ghcDbStackOpts ([GhcPkgDb] -> [FilePath]) -> [GhcPkgDb] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Cradle -> [GhcPkgDb]
cradlePkgDbStack Cradle
cradle
        compOpts :: CompilerOptions
compOpts
            | [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
pkgOpts = [FilePath] -> [FilePath] -> [Package] -> CompilerOptions
CompilerOptions [FilePath]
ghcopts [FilePath]
importDirs []
            | Bool
otherwise = [FilePath] -> [FilePath] -> [Package] -> CompilerOptions
CompilerOptions ([FilePath]
ghcopts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkgOpts) [FilePath
wdir, FilePath
rdir] []
        wdir :: FilePath
wdir = Cradle -> FilePath
cradleCurrentDir Cradle
cradle
        rdir :: FilePath
rdir = Cradle -> FilePath
cradleRootDir Cradle
cradle

----------------------------------------------------------------

initSession
    :: Build
    -> Options
    -> CompilerOptions
    -> Ghc ()
initSession :: Build -> Options -> CompilerOptions -> Ghc ()
initSession Build
build Options{} CompilerOptions{[FilePath]
[Package]
ghcOptions :: [FilePath]
includeDirs :: [FilePath]
depPackages :: [Package]
ghcOptions :: CompilerOptions -> [FilePath]
includeDirs :: CompilerOptions -> [FilePath]
depPackages :: CompilerOptions -> [Package]
..} = do
    DynFlags
df <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
    Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$
        DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags
            (DynFlags -> Ghc ()) -> Ghc DynFlags -> Ghc ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath] -> DynFlags -> Ghc DynFlags
addCmdOpts
                [FilePath]
ghcOptions
                ( DynFlags -> DynFlags
setLinkerOptions (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$
                    [FilePath] -> DynFlags -> DynFlags
setIncludeDirs [FilePath]
includeDirs (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$
                        Build -> DynFlags -> DynFlags
setBuildEnv Build
build (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$
                            DynFlags -> DynFlags
setEmptyLogger (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$
                                [Package] -> DynFlags -> DynFlags
addPackageFlags [Package]
depPackages DynFlags
df
                )

----------------------------------------------------------------

setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
setIncludeDirs :: [FilePath] -> DynFlags -> DynFlags
setIncludeDirs [FilePath]
idirs DynFlags
df = DynFlags
df{importPaths = idirs}

setBuildEnv :: Build -> DynFlags -> DynFlags
setBuildEnv :: Build -> DynFlags -> DynFlags
setBuildEnv Build
build = Build -> DynFlags -> DynFlags
setHideAllPackages Build
build (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Build -> DynFlags -> DynFlags
setCabalPackage Build
build

-- At the moment with this option set ghc only prints different error messages,
-- suggesting the user to add a hidden package to the build-depends in his cabal
-- file for example
setCabalPackage :: Build -> DynFlags -> DynFlags
setCabalPackage :: Build -> DynFlags -> DynFlags
setCabalPackage Build
CabalPkg DynFlags
df = DynFlags -> DynFlags
setCabalPkg DynFlags
df
setCabalPackage Build
_ DynFlags
df = DynFlags
df

-- | Enable hiding of all package not explicitly exposed (like Cabal does)
setHideAllPackages :: Build -> DynFlags -> DynFlags
setHideAllPackages :: Build -> DynFlags -> DynFlags
setHideAllPackages Build
CabalPkg DynFlags
df = DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
df GeneralFlag
Opt_HideAllPackages
setHideAllPackages Build
_ DynFlags
df = DynFlags
df

-- | Parse command line ghc options and add them to the 'DynFlags' passed
addCmdOpts :: [GHCOption] -> DynFlags -> Ghc DynFlags
addCmdOpts :: [FilePath] -> DynFlags -> Ghc DynFlags
addCmdOpts [FilePath]
cmdOpts DynFlags
df =
    (DynFlags, [Located FilePath], [Warn]) -> DynFlags
forall {a} {b} {c}. (a, b, c) -> a
tfst ((DynFlags, [Located FilePath], [Warn]) -> DynFlags)
-> Ghc (DynFlags, [Located FilePath], [Warn]) -> Ghc DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags
-> [Located FilePath] -> Ghc (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
parseDynamicFlagsCmdLine DynFlags
df ((FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Located FilePath
forall e. e -> Located e
G.noLoc [FilePath]
cmdOpts)
  where
    tfst :: (a, b, c) -> a
tfst (a
a, b
_, c
_) = a
a

----------------------------------------------------------------

-- | Set the files as targets and load them.
setTargetFiles :: [FilePath] -> Ghc ()
setTargetFiles :: [FilePath] -> Ghc ()
setTargetFiles [FilePath]
files = do
    [Target]
targets <- [FilePath] -> (FilePath -> Ghc Target) -> Ghc [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
files ((FilePath -> Ghc Target) -> Ghc [Target])
-> (FilePath -> Ghc Target) -> Ghc [Target]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> FilePath -> Ghc Target
forall (m :: * -> *). GhcMonad m => FilePath -> m Target
guessTarget FilePath
file
    [Target] -> Ghc ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
G.setTargets [Target]
targets
    Ghc SuccessFlag -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc SuccessFlag -> Ghc ()) -> Ghc SuccessFlag -> Ghc ()
forall a b. (a -> b) -> a -> b
$ LoadHowMuch -> Ghc SuccessFlag
forall (f :: * -> *). GhcMonad f => LoadHowMuch -> f SuccessFlag
G.load LoadHowMuch
LoadAllTargets

----------------------------------------------------------------

-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags :: IO DynFlags
getDynamicFlags = do
    Maybe FilePath
mlibdir <- IO (Maybe FilePath)
getSystemLibDir
    Maybe FilePath -> Ghc DynFlags -> IO DynFlags
forall a. Maybe FilePath -> Ghc a -> IO a
G.runGhc Maybe FilePath
mlibdir Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags

withDynFlags :: (DynFlags -> DynFlags) -> Ghc a -> Ghc a
withDynFlags :: forall a. (DynFlags -> DynFlags) -> Ghc a -> Ghc a
withDynFlags DynFlags -> DynFlags
setFlag Ghc a
body = Ghc DynFlags
-> (DynFlags -> Ghc ()) -> (DynFlags -> Ghc a) -> Ghc a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket Ghc DynFlags
setup DynFlags -> Ghc ()
teardown (Ghc a -> DynFlags -> Ghc a
forall a b. a -> b -> a
const Ghc a
body)
  where
    setup :: Ghc DynFlags
setup = do
        DynFlags
dflag <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
        Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags (DynFlags -> DynFlags
setFlag DynFlags
dflag)
        DynFlags -> Ghc DynFlags
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflag
    teardown :: DynFlags -> Ghc ()
teardown = Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> (DynFlags -> Ghc ()) -> DynFlags -> Ghc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags

withCmdFlags :: [GHCOption] -> Ghc a -> Ghc a
withCmdFlags :: forall a. [FilePath] -> Ghc a -> Ghc a
withCmdFlags [FilePath]
flags Ghc a
body = Ghc DynFlags
-> (DynFlags -> Ghc ()) -> (DynFlags -> Ghc a) -> Ghc a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket Ghc DynFlags
setup DynFlags -> Ghc ()
teardown (Ghc a -> DynFlags -> Ghc a
forall a b. a -> b -> a
const Ghc a
body)
  where
    setup :: Ghc DynFlags
setup = do
        DynFlags
dflag <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags Ghc DynFlags -> (DynFlags -> Ghc DynFlags) -> Ghc DynFlags
forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> DynFlags -> Ghc DynFlags
addCmdOpts [FilePath]
flags
        Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags DynFlags
dflag
        DynFlags -> Ghc DynFlags
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
dflag
    teardown :: DynFlags -> Ghc ()
teardown = Ghc () -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc () -> Ghc ()) -> (DynFlags -> Ghc ()) -> DynFlags -> Ghc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
G.setSessionDynFlags

----------------------------------------------------------------

-- | Set 'DynFlags' equivalent to "-fdefer-typed-holes"
setDeferTypedHoles :: DynFlags -> DynFlags
setDeferTypedHoles :: DynFlags -> DynFlags
setDeferTypedHoles DynFlags
dflag = DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflag GeneralFlag
G.Opt_DeferTypedHoles

-- | Set 'DynFlags' equivalent to "-fdefer-type-errors"
setDeferTypeErrors :: DynFlags -> DynFlags
setDeferTypeErrors :: DynFlags -> DynFlags
setDeferTypeErrors DynFlags
dflag = DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflag GeneralFlag
G.Opt_DeferTypeErrors

-- | Set 'DynFlags' equivalent to "-Wtyped-holes"
setWarnTypedHoles :: DynFlags -> DynFlags
setWarnTypedHoles :: DynFlags -> DynFlags
setWarnTypedHoles DynFlags
dflag = DynFlags -> WarningFlag -> DynFlags
wopt_set DynFlags
dflag WarningFlag
Opt_WarnTypedHoles

-- | Set 'DynFlags' equivalent to "-XPartialTypeSignatures"
setPartialSignatures :: DynFlags -> DynFlags
setPartialSignatures :: DynFlags -> DynFlags
setPartialSignatures DynFlags
df = DynFlags -> Extension -> DynFlags
xopt_set (DynFlags -> Extension -> DynFlags
xopt_set DynFlags
df Extension
PartialTypeSignatures) Extension
NamedWildCards

-- | Set 'DynFlags' equivalent to "-w:".
setNoWarningFlags :: DynFlags -> DynFlags
setNoWarningFlags :: DynFlags -> DynFlags
setNoWarningFlags DynFlags
df = DynFlags
df{warningFlags = E.empty}

-- | Set 'DynFlags' equivalent to "-Wall".
setAllWarningFlags :: DynFlags -> DynFlags
setAllWarningFlags :: DynFlags -> DynFlags
setAllWarningFlags DynFlags
df = DynFlags
df{warningFlags = allWarningFlags}

{-# NOINLINE allWarningFlags #-}
allWarningFlags :: E.EnumSet WarningFlag
allWarningFlags :: EnumSet WarningFlag
allWarningFlags = IO (EnumSet WarningFlag) -> EnumSet WarningFlag
forall a. IO a -> a
unsafePerformIO (IO (EnumSet WarningFlag) -> EnumSet WarningFlag)
-> IO (EnumSet WarningFlag) -> EnumSet WarningFlag
forall a b. (a -> b) -> a -> b
$ do
    Maybe FilePath
mlibdir <- IO (Maybe FilePath)
getSystemLibDir
    Maybe FilePath
-> Ghc (EnumSet WarningFlag) -> IO (EnumSet WarningFlag)
forall a. Maybe FilePath -> Ghc a -> IO a
G.runGhc Maybe FilePath
mlibdir (Ghc (EnumSet WarningFlag) -> IO (EnumSet WarningFlag))
-> Ghc (EnumSet WarningFlag) -> IO (EnumSet WarningFlag)
forall a b. (a -> b) -> a -> b
$ do
        DynFlags
df <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
        DynFlags
df' <- [FilePath] -> DynFlags -> Ghc DynFlags
addCmdOpts [FilePath
"-Wall"] DynFlags
df
        EnumSet WarningFlag -> Ghc (EnumSet WarningFlag)
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumSet WarningFlag -> Ghc (EnumSet WarningFlag))
-> EnumSet WarningFlag -> Ghc (EnumSet WarningFlag)
forall a b. (a -> b) -> a -> b
$ DynFlags -> EnumSet WarningFlag
G.warningFlags DynFlags
df'

setCabalPkg :: DynFlags -> DynFlags
setCabalPkg :: DynFlags -> DynFlags
setCabalPkg DynFlags
dflag = DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflag GeneralFlag
Opt_BuildingCabalPackage

addPackageFlags :: [Package] -> DynFlags -> DynFlags
addPackageFlags :: [Package] -> DynFlags -> DynFlags
addPackageFlags [Package]
pkgs DynFlags
df =
    DynFlags
df{packageFlags = packageFlags df ++ expose `map` pkgs}
  where
    expose :: Package -> PackageFlag
expose Package
pkg = FilePath -> PackageArg -> ModRenaming -> PackageFlag
ExposePackage FilePath
pkgid (FilePath -> PackageArg
PackageArg FilePath
name) (Bool -> [(ModuleName, ModuleName)] -> ModRenaming
ModRenaming Bool
True [])
      where
        (FilePath
name, FilePath
_, FilePath
_) = Package
pkg
        pkgid :: FilePath
pkgid = Package -> FilePath
showPkgId Package
pkg