{-# LANGUAGE CPP, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly

-----------------------------------------------------------------------------
--
-- Monadery code used in InteractiveUI
--
-- (c) The GHC Team 2005-2006
--
-----------------------------------------------------------------------------

module Clash.GHCi.UI.Monad (
        GHCi(..), startGHCi,
        GHCiState(..), setGHCiState, getGHCiState, modifyGHCiState,
        GHCiOption(..), isOptionSet, setOption, unsetOption,
        Command(..), CommandResult(..), cmdSuccess,
        PromptFunction,
        BreakLocation(..),
        TickArray,
        getDynFlags,

        runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
        ActionStats(..), runAndPrintStats, runWithStats, printStats,

        printForUserNeverQualify, printForUserModInfo,
        printForUser, printForUserPartWay, prettyLocations,

        compileGHCiExpr,
        initInterpBuffering,
        turnOffBuffering, turnOffBuffering_,
        flushInterpBuffers,
        mkEvalWrapper
    ) where

#include "HsVersions.h"

import Clash.GHCi.UI.Info (ModInfo)
import qualified GHC
import GhcMonad         hiding (liftIO)
import Outputable       hiding (printForUser, printForUserPartWay)
import qualified Outputable
import OccName
import DynFlags
import FastString
import HscTypes
import SrcLoc
import Module
import RdrName (mkOrig)
import PrelNames (gHC_GHCI_HELPERS)
import GHCi
import GHCi.RemoteTypes
import HsSyn (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import HsUtils
import Util

import Exception
import Numeric
import Data.Array
import Data.IORef
import Data.Time
import System.Environment
import System.IO
import Control.Monad
import Prelude hiding ((<>))

import System.Console.Haskeline (CompletionFunc, InputT)
import qualified System.Console.Haskeline as Haskeline
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
import qualified GHC.LanguageExtensions as LangExt

-----------------------------------------------------------------------------
-- GHCi monad

data GHCiState = GHCiState
     {
        GHCiState -> String
progname       :: String,
        GHCiState -> [String]
args           :: [String],
        GHCiState -> ForeignHValue
evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@
        GHCiState -> PromptFunction
prompt         :: PromptFunction,
        GHCiState -> PromptFunction
prompt_cont    :: PromptFunction,
        GHCiState -> String
editor         :: String,
        GHCiState -> String
stop           :: String,
        GHCiState -> [GHCiOption]
options        :: [GHCiOption],
        GHCiState -> Int
line_number    :: !Int,         -- ^ input line
        GHCiState -> Int
break_ctr      :: !Int,
        GHCiState -> [(Int, BreakLocation)]
breaks         :: ![(Int, BreakLocation)],
        GHCiState -> ModuleEnv TickArray
tickarrays     :: ModuleEnv TickArray,
            -- ^ 'tickarrays' caches the 'TickArray' for loaded modules,
            -- so that we don't rebuild it each time the user sets
            -- a breakpoint.
        GHCiState -> [Command]
ghci_commands  :: [Command],
            -- ^ available ghci commands
        GHCiState -> [Command]
ghci_macros    :: [Command],
            -- ^ user-defined macros
        GHCiState -> Maybe Command
last_command   :: Maybe Command,
            -- ^ @:@ at the GHCi prompt repeats the last command, so we
            -- remember it here
        GHCiState -> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
cmd_wrapper    :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool),
            -- ^ The command wrapper is run for each command or statement.
            -- The 'Bool' value denotes whether the command is successful and
            -- 'Nothing' means to exit GHCi.
        GHCiState -> [String]
cmdqueue       :: [String],

        GHCiState -> [InteractiveImport]
remembered_ctx :: [InteractiveImport],
            -- ^ The imports that the user has asked for, via import
            -- declarations and :module commands.  This list is
            -- persistent over :reloads (but any imports for modules
            -- that are not loaded are temporarily ignored).  After a
            -- :load, all the home-package imports are stripped from
            -- this list.
            --
            -- See bugs #2049, #1873, #1360

        GHCiState -> [InteractiveImport]
transient_ctx  :: [InteractiveImport],
            -- ^ An import added automatically after a :load, usually of
            -- the most recently compiled module.  May be empty if
            -- there are no modules loaded.  This list is replaced by
            -- :load, :reload, and :add.  In between it may be modified
            -- by :module.

        GHCiState -> [ImportDecl GhcPs]
extra_imports  :: [ImportDecl GhcPs],
            -- ^ These are "always-on" imports, added to the
            -- context regardless of what other imports we have.
            -- This is useful for adding imports that are required
            -- by setGHCiMonad.  Be careful adding things here:
            -- you can create ambiguities if these imports overlap
            -- with other things in scope.
            --
            -- NB. although this is not currently used by GHCi itself,
            -- it was added to support other front-ends that are based
            -- on the GHCi code.  Potentially we could also expose
            -- this functionality via GHCi commands.

        GHCiState -> [ImportDecl GhcPs]
prelude_imports :: [ImportDecl GhcPs],
            -- ^ These imports are added to the context when
            -- -XImplicitPrelude is on and we don't have a *-module
            -- in the context.  They can also be overridden by another
            -- import for the same module, e.g.
            -- "import Prelude hiding (map)"

        GHCiState -> Bool
ghc_e :: Bool, -- ^ True if this is 'ghc -e' (or runghc)

        GHCiState -> String
short_help :: String,
            -- ^ help text to display to a user
        GHCiState -> String
long_help  :: String,
        GHCiState -> IORef [(FastString, Int)]
lastErrorLocations :: IORef [(FastString, Int)],

        GHCiState -> Map ModuleName ModInfo
mod_infos  :: !(Map ModuleName ModInfo),

        GHCiState -> ForeignHValue
flushStdHandles :: ForeignHValue,
            -- ^ @hFlush stdout; hFlush stderr@ in the interpreter
        GHCiState -> ForeignHValue
noBuffering :: ForeignHValue
            -- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
     }

type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]

-- | A GHCi command
data Command
   = Command
   { Command -> String
cmdName           :: String
     -- ^ Name of GHCi command (e.g. "exit")
   , Command -> String -> InputT GHCi Bool
cmdAction         :: String -> InputT GHCi Bool
     -- ^ The 'Bool' value denotes whether to exit GHCi
   , Command -> Bool
cmdHidden         :: Bool
     -- ^ Commands which are excluded from default completion
     -- and @:help@ summary. This is usually set for commands not
     -- useful for interactive use but rather for IDEs.
   , Command -> CompletionFunc GHCi
cmdCompletionFunc :: CompletionFunc GHCi
     -- ^ 'CompletionFunc' for arguments
   }

data CommandResult
   = CommandComplete
   { CommandResult -> String
cmdInput :: String
   , CommandResult -> Either SomeException (Maybe Bool)
cmdResult :: Either SomeException (Maybe Bool)
   , CommandResult -> ActionStats
cmdStats :: ActionStats
   }
   | CommandIncomplete
     -- ^ Unterminated multiline command
   deriving Int -> CommandResult -> ShowS
[CommandResult] -> ShowS
CommandResult -> String
(Int -> CommandResult -> ShowS)
-> (CommandResult -> String)
-> ([CommandResult] -> ShowS)
-> Show CommandResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandResult] -> ShowS
$cshowList :: [CommandResult] -> ShowS
show :: CommandResult -> String
$cshow :: CommandResult -> String
showsPrec :: Int -> CommandResult -> ShowS
$cshowsPrec :: Int -> CommandResult -> ShowS
Show

cmdSuccess :: Haskeline.MonadException m => CommandResult -> m (Maybe Bool)
cmdSuccess :: CommandResult -> m (Maybe Bool)
cmdSuccess CommandComplete{ cmdResult :: CommandResult -> Either SomeException (Maybe Bool)
cmdResult = Left e :: SomeException
e } = IO (Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ SomeException -> IO (Maybe Bool)
forall e a. Exception e => e -> IO a
throwIO SomeException
e
cmdSuccess CommandComplete{ cmdResult :: CommandResult -> Either SomeException (Maybe Bool)
cmdResult = Right r :: Maybe Bool
r } = Maybe Bool -> m (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
r
cmdSuccess CommandIncomplete = Maybe Bool -> m (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True

type PromptFunction = [String]
                   -> Int
                   -> GHCi SDoc

data GHCiOption
        = ShowTiming            -- show time/allocs after evaluation
        | ShowType              -- show the type of expressions
        | RevertCAFs            -- revert CAFs after every evaluation
        | Multiline             -- use multiline commands
        | CollectInfo           -- collect and cache information about
                                -- modules after load
        deriving GHCiOption -> GHCiOption -> Bool
(GHCiOption -> GHCiOption -> Bool)
-> (GHCiOption -> GHCiOption -> Bool) -> Eq GHCiOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHCiOption -> GHCiOption -> Bool
$c/= :: GHCiOption -> GHCiOption -> Bool
== :: GHCiOption -> GHCiOption -> Bool
$c== :: GHCiOption -> GHCiOption -> Bool
Eq

data BreakLocation
   = BreakLocation
   { BreakLocation -> Module
breakModule :: !GHC.Module
   , BreakLocation -> SrcSpan
breakLoc    :: !SrcSpan
   , BreakLocation -> Int
breakTick   :: {-# UNPACK #-} !Int
   , BreakLocation -> String
onBreakCmd  :: String
   }

instance Eq BreakLocation where
  loc1 :: BreakLocation
loc1 == :: BreakLocation -> BreakLocation -> Bool
== loc2 :: BreakLocation
loc2 = BreakLocation -> Module
breakModule BreakLocation
loc1 Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== BreakLocation -> Module
breakModule BreakLocation
loc2 Bool -> Bool -> Bool
&&
                 BreakLocation -> Int
breakTick BreakLocation
loc1   Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== BreakLocation -> Int
breakTick BreakLocation
loc2

prettyLocations :: [(Int, BreakLocation)] -> SDoc
prettyLocations :: [(Int, BreakLocation)] -> SDoc
prettyLocations []   = String -> SDoc
text "No active breakpoints."
prettyLocations locs :: [(Int, BreakLocation)]
locs = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((Int, BreakLocation) -> SDoc) -> [(Int, BreakLocation)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(i :: Int
i, loc :: BreakLocation
loc) -> SDoc -> SDoc
brackets (Int -> SDoc
int Int
i) SDoc -> SDoc -> SDoc
<+> BreakLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr BreakLocation
loc) ([(Int, BreakLocation)] -> [SDoc])
-> [(Int, BreakLocation)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [(Int, BreakLocation)] -> [(Int, BreakLocation)]
forall a. [a] -> [a]
reverse ([(Int, BreakLocation)] -> [(Int, BreakLocation)])
-> [(Int, BreakLocation)] -> [(Int, BreakLocation)]
forall a b. (a -> b) -> a -> b
$ [(Int, BreakLocation)]
locs

instance Outputable BreakLocation where
   ppr :: BreakLocation -> SDoc
ppr loc :: BreakLocation
loc = (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> SDoc) -> Module -> SDoc
forall a b. (a -> b) -> a -> b
$ BreakLocation -> Module
breakModule BreakLocation
loc) SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BreakLocation -> SrcSpan
breakLoc BreakLocation
loc) SDoc -> SDoc -> SDoc
<+>
                if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BreakLocation -> String
onBreakCmd BreakLocation
loc)
                   then SDoc
Outputable.empty
                   else SDoc -> SDoc
doubleQuotes (String -> SDoc
text (BreakLocation -> String
onBreakCmd BreakLocation
loc))

recordBreak :: BreakLocation -> GHCi (Bool{- was already present -}, Int)
recordBreak :: BreakLocation -> GHCi (Bool, Int)
recordBreak brkLoc :: BreakLocation
brkLoc = do
   GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
   let oldActiveBreaks :: [(Int, BreakLocation)]
oldActiveBreaks = GHCiState -> [(Int, BreakLocation)]
breaks GHCiState
st
   -- don't store the same break point twice
   case [ Int
nm | (nm :: Int
nm, loc :: BreakLocation
loc) <- [(Int, BreakLocation)]
oldActiveBreaks, BreakLocation
loc BreakLocation -> BreakLocation -> Bool
forall a. Eq a => a -> a -> Bool
== BreakLocation
brkLoc ] of
     (nm :: Int
nm:_) -> (Bool, Int) -> GHCi (Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
nm)
     [] -> do
      let oldCounter :: Int
oldCounter = GHCiState -> Int
break_ctr GHCiState
st
          newCounter :: Int
newCounter = Int
oldCounter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
      GHCiState -> GHCi ()
forall (m :: * -> *). HasGhciState m => GHCiState -> m ()
setGHCiState (GHCiState -> GHCi ()) -> GHCiState -> GHCi ()
forall a b. (a -> b) -> a -> b
$ GHCiState
st { break_ctr :: Int
break_ctr = Int
newCounter,
                          breaks :: [(Int, BreakLocation)]
breaks = (Int
oldCounter, BreakLocation
brkLoc) (Int, BreakLocation)
-> [(Int, BreakLocation)] -> [(Int, BreakLocation)]
forall a. a -> [a] -> [a]
: [(Int, BreakLocation)]
oldActiveBreaks
                        }
      (Bool, Int) -> GHCi (Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int
oldCounter)

newtype GHCi a = GHCi { GHCi a -> IORef GHCiState -> Ghc a
unGHCi :: IORef GHCiState -> Ghc a }

reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi (s :: Session
s, gs :: IORef GHCiState
gs) m :: GHCi a
m = Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc (GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi GHCi a
m IORef GHCiState
gs) Session
s

reifyGHCi :: ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi :: ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi f :: (Session, IORef GHCiState) -> IO a
f = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi IORef GHCiState -> Ghc a
f'
  where
    -- f' :: IORef GHCiState -> Ghc a
    f' :: IORef GHCiState -> Ghc a
f' gs :: IORef GHCiState
gs = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
reifyGhc (IORef GHCiState -> Session -> IO a
f'' IORef GHCiState
gs)
    -- f'' :: IORef GHCiState -> Session -> IO a
    f'' :: IORef GHCiState -> Session -> IO a
f'' gs :: IORef GHCiState
gs s :: Session
s = (Session, IORef GHCiState) -> IO a
f (Session
s, IORef GHCiState
gs)

startGHCi :: GHCi a -> GHCiState -> Ghc a
startGHCi :: GHCi a -> GHCiState -> Ghc a
startGHCi g :: GHCi a
g state :: GHCiState
state = do IORef GHCiState
ref <- IO (IORef GHCiState) -> Ghc (IORef GHCiState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef GHCiState) -> Ghc (IORef GHCiState))
-> IO (IORef GHCiState) -> Ghc (IORef GHCiState)
forall a b. (a -> b) -> a -> b
$ GHCiState -> IO (IORef GHCiState)
forall a. a -> IO (IORef a)
newIORef GHCiState
state; GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi GHCi a
g IORef GHCiState
ref

instance Functor GHCi where
    fmap :: (a -> b) -> GHCi a -> GHCi b
fmap = (a -> b) -> GHCi a -> GHCi b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative GHCi where
    pure :: a -> GHCi a
pure a :: a
a = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc a) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \_ -> a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    <*> :: GHCi (a -> b) -> GHCi a -> GHCi b
(<*>) = GHCi (a -> b) -> GHCi a -> GHCi b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad GHCi where
  (GHCi m :: IORef GHCiState -> Ghc a
m) >>= :: GHCi a -> (a -> GHCi b) -> GHCi b
>>= k :: a -> GHCi b
k  =  (IORef GHCiState -> Ghc b) -> GHCi b
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc b) -> GHCi b)
-> (IORef GHCiState -> Ghc b) -> GHCi b
forall a b. (a -> b) -> a -> b
$ \s :: IORef GHCiState
s -> IORef GHCiState -> Ghc a
m IORef GHCiState
s Ghc a -> (a -> Ghc b) -> Ghc b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> GHCi b -> IORef GHCiState -> Ghc b
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi (a -> GHCi b
k a
a) IORef GHCiState
s

class HasGhciState m where
    getGHCiState    :: m GHCiState
    setGHCiState    :: GHCiState -> m ()
    modifyGHCiState :: (GHCiState -> GHCiState) -> m ()

instance HasGhciState GHCi where
    getGHCiState :: GHCi GHCiState
getGHCiState      = (IORef GHCiState -> Ghc GHCiState) -> GHCi GHCiState
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc GHCiState) -> GHCi GHCiState)
-> (IORef GHCiState -> Ghc GHCiState) -> GHCi GHCiState
forall a b. (a -> b) -> a -> b
$ \r :: IORef GHCiState
r -> IO GHCiState -> Ghc GHCiState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GHCiState -> Ghc GHCiState) -> IO GHCiState -> Ghc GHCiState
forall a b. (a -> b) -> a -> b
$ IORef GHCiState -> IO GHCiState
forall a. IORef a -> IO a
readIORef IORef GHCiState
r
    setGHCiState :: GHCiState -> GHCi ()
setGHCiState s :: GHCiState
s    = (IORef GHCiState -> Ghc ()) -> GHCi ()
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc ()) -> GHCi ())
-> (IORef GHCiState -> Ghc ()) -> GHCi ()
forall a b. (a -> b) -> a -> b
$ \r :: IORef GHCiState
r -> IO () -> Ghc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ IORef GHCiState -> GHCiState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef GHCiState
r GHCiState
s
    modifyGHCiState :: (GHCiState -> GHCiState) -> GHCi ()
modifyGHCiState f :: GHCiState -> GHCiState
f = (IORef GHCiState -> Ghc ()) -> GHCi ()
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc ()) -> GHCi ())
-> (IORef GHCiState -> Ghc ()) -> GHCi ()
forall a b. (a -> b) -> a -> b
$ \r :: IORef GHCiState
r -> IO () -> Ghc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ IORef GHCiState -> (GHCiState -> GHCiState) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef GHCiState
r GHCiState -> GHCiState
f

instance (MonadTrans t, Monad m, HasGhciState m) => HasGhciState (t m) where
    getGHCiState :: t m GHCiState
getGHCiState    = m GHCiState -> t m GHCiState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
    setGHCiState :: GHCiState -> t m ()
setGHCiState    = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (GHCiState -> m ()) -> GHCiState -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCiState -> m ()
forall (m :: * -> *). HasGhciState m => GHCiState -> m ()
setGHCiState
    modifyGHCiState :: (GHCiState -> GHCiState) -> t m ()
modifyGHCiState = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ())
-> ((GHCiState -> GHCiState) -> m ())
-> (GHCiState -> GHCiState)
-> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCiState -> GHCiState) -> m ()
forall (m :: * -> *).
HasGhciState m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState

liftGhc :: Ghc a -> GHCi a
liftGhc :: Ghc a -> GHCi a
liftGhc m :: Ghc a
m = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc a) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \_ -> Ghc a
m

instance MonadIO GHCi where
  liftIO :: IO a -> GHCi a
liftIO = Ghc a -> GHCi a
forall a. Ghc a -> GHCi a
liftGhc (Ghc a -> GHCi a) -> (IO a -> Ghc a) -> IO a -> GHCi a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance HasDynFlags GHCi where
  getDynFlags :: GHCi DynFlags
getDynFlags = GHCi DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags

instance GhcMonad GHCi where
  setSession :: HscEnv -> GHCi ()
setSession s' :: HscEnv
s' = Ghc () -> GHCi ()
forall a. Ghc a -> GHCi a
liftGhc (Ghc () -> GHCi ()) -> Ghc () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> Ghc ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
s'
  getSession :: GHCi HscEnv
getSession    = Ghc HscEnv -> GHCi HscEnv
forall a. Ghc a -> GHCi a
liftGhc (Ghc HscEnv -> GHCi HscEnv) -> Ghc HscEnv -> GHCi HscEnv
forall a b. (a -> b) -> a -> b
$ Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession

instance HasDynFlags (InputT GHCi) where
  getDynFlags :: InputT GHCi DynFlags
getDynFlags = GHCi DynFlags -> InputT GHCi DynFlags
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

instance GhcMonad (InputT GHCi) where
  setSession :: HscEnv -> InputT GHCi ()
setSession = GHCi () -> InputT GHCi ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> (HscEnv -> GHCi ()) -> HscEnv -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> GHCi ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession
  getSession :: InputT GHCi HscEnv
getSession = GHCi HscEnv -> InputT GHCi HscEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession

instance ExceptionMonad GHCi where
  gcatch :: GHCi a -> (e -> GHCi a) -> GHCi a
gcatch m :: GHCi a
m h :: e -> GHCi a
h = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc a) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \r :: IORef GHCiState
r -> GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi GHCi a
m IORef GHCiState
r Ghc a -> (e -> Ghc a) -> Ghc a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
`gcatch` (\e :: e
e -> GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi (e -> GHCi a
h e
e) IORef GHCiState
r)
  gmask :: ((GHCi a -> GHCi a) -> GHCi b) -> GHCi b
gmask f :: (GHCi a -> GHCi a) -> GHCi b
f =
      (IORef GHCiState -> Ghc b) -> GHCi b
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc b) -> GHCi b)
-> (IORef GHCiState -> Ghc b) -> GHCi b
forall a b. (a -> b) -> a -> b
$ \s :: IORef GHCiState
s -> ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask (((Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \io_restore :: Ghc a -> Ghc a
io_restore ->
                             let
                                g_restore :: GHCi a -> GHCi a
g_restore (GHCi m :: IORef GHCiState -> Ghc a
m) = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc a) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \s' :: IORef GHCiState
s' -> Ghc a -> Ghc a
io_restore (IORef GHCiState -> Ghc a
m IORef GHCiState
s')
                             in
                                GHCi b -> IORef GHCiState -> Ghc b
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi ((GHCi a -> GHCi a) -> GHCi b
f GHCi a -> GHCi a
g_restore) IORef GHCiState
s

instance Haskeline.MonadException Ghc where
  controlIO :: (RunIO Ghc -> IO (Ghc a)) -> Ghc a
controlIO f :: RunIO Ghc -> IO (Ghc a)
f = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> (RunIO IO -> IO (IO a)) -> IO a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
Haskeline.controlIO ((RunIO IO -> IO (IO a)) -> IO a)
-> (RunIO IO -> IO (IO a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Haskeline.RunIO run :: forall b. IO b -> IO (IO b)
run) -> let
                    run' :: RunIO Ghc
run' = (forall b. Ghc b -> IO (Ghc b)) -> RunIO Ghc
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
Haskeline.RunIO ((IO b -> Ghc b) -> IO (IO b) -> IO (Ghc b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b)
-> (IO b -> Session -> IO b) -> IO b -> Ghc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> Session -> IO b
forall a b. a -> b -> a
const) (IO (IO b) -> IO (Ghc b))
-> (Ghc b -> IO (IO b)) -> Ghc b -> IO (Ghc b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> IO (IO b)
forall b. IO b -> IO (IO b)
run (IO b -> IO (IO b)) -> (Ghc b -> IO b) -> Ghc b -> IO (IO b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ghc b -> Session -> IO b) -> Session -> Ghc b -> IO b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc Session
s)
                    in (Ghc a -> IO a) -> IO (Ghc a) -> IO (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ghc a -> Session -> IO a) -> Session -> Ghc a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Session
s) (IO (Ghc a) -> IO (IO a)) -> IO (Ghc a) -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ RunIO Ghc -> IO (Ghc a)
f RunIO Ghc
run'

instance Haskeline.MonadException GHCi where
  controlIO :: (RunIO GHCi -> IO (GHCi a)) -> GHCi a
controlIO f :: RunIO GHCi -> IO (GHCi a)
f = (IORef GHCiState -> Ghc a) -> GHCi a
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc a) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \s :: IORef GHCiState
s -> (RunIO Ghc -> IO (Ghc a)) -> Ghc a
forall (m :: * -> *) a.
MonadException m =>
(RunIO m -> IO (m a)) -> m a
Haskeline.controlIO ((RunIO Ghc -> IO (Ghc a)) -> Ghc a)
-> (RunIO Ghc -> IO (Ghc a)) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \(Haskeline.RunIO run :: forall b. Ghc b -> IO (Ghc b)
run) -> let
                    run' :: RunIO GHCi
run' = (forall b. GHCi b -> IO (GHCi b)) -> RunIO GHCi
forall (m :: * -> *). (forall b. m b -> IO (m b)) -> RunIO m
Haskeline.RunIO ((Ghc b -> GHCi b) -> IO (Ghc b) -> IO (GHCi b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IORef GHCiState -> Ghc b) -> GHCi b
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc b) -> GHCi b)
-> (Ghc b -> IORef GHCiState -> Ghc b) -> Ghc b -> GHCi b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ghc b -> IORef GHCiState -> Ghc b
forall a b. a -> b -> a
const) (IO (Ghc b) -> IO (GHCi b))
-> (GHCi b -> IO (Ghc b)) -> GHCi b -> IO (GHCi b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ghc b -> IO (Ghc b)
forall b. Ghc b -> IO (Ghc b)
run (Ghc b -> IO (Ghc b)) -> (GHCi b -> Ghc b) -> GHCi b -> IO (Ghc b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCi b -> IORef GHCiState -> Ghc b)
-> IORef GHCiState -> GHCi b -> Ghc b
forall a b c. (a -> b -> c) -> b -> a -> c
flip GHCi b -> IORef GHCiState -> Ghc b
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi IORef GHCiState
s)
                    in (GHCi a -> Ghc a) -> IO (GHCi a) -> IO (Ghc a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GHCi a -> IORef GHCiState -> Ghc a)
-> IORef GHCiState -> GHCi a -> Ghc a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi IORef GHCiState
s) (IO (GHCi a) -> IO (Ghc a)) -> IO (GHCi a) -> IO (Ghc a)
forall a b. (a -> b) -> a -> b
$ RunIO GHCi -> IO (GHCi a)
f RunIO GHCi
run'

instance ExceptionMonad (InputT GHCi) where
  gcatch :: InputT GHCi a -> (e -> InputT GHCi a) -> InputT GHCi a
gcatch = InputT GHCi a -> (e -> InputT GHCi a) -> InputT GHCi a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
Haskeline.catch
  gmask :: ((InputT GHCi a -> InputT GHCi a) -> InputT GHCi b)
-> InputT GHCi b
gmask f :: (InputT GHCi a -> InputT GHCi a) -> InputT GHCi b
f = (((IO (InputT GHCi a) -> IO (InputT GHCi a)) -> IO (InputT GHCi b))
 -> IO (InputT GHCi b))
-> ((IO (InputT GHCi a) -> IO (InputT GHCi a)) -> InputT GHCi b)
-> InputT GHCi b
forall (m :: * -> *) a b c.
MonadException m =>
((a -> IO (m b)) -> IO (m c)) -> (a -> m b) -> m c
Haskeline.liftIOOp ((IO (InputT GHCi a) -> IO (InputT GHCi a)) -> IO (InputT GHCi b))
-> IO (InputT GHCi b)
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask ((InputT GHCi a -> InputT GHCi a) -> InputT GHCi b
f ((InputT GHCi a -> InputT GHCi a) -> InputT GHCi b)
-> ((IO (InputT GHCi a) -> IO (InputT GHCi a))
    -> InputT GHCi a -> InputT GHCi a)
-> (IO (InputT GHCi a) -> IO (InputT GHCi a))
-> InputT GHCi b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (InputT GHCi a) -> IO (InputT GHCi a))
-> InputT GHCi a -> InputT GHCi a
forall (m :: * -> *) a.
MonadException m =>
(IO (m a) -> IO (m a)) -> m a -> m a
Haskeline.liftIOOp_)

isOptionSet :: GHCiOption -> GHCi Bool
isOptionSet :: GHCiOption -> GHCi Bool
isOptionSet opt :: GHCiOption
opt
 = do GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
      Bool -> GHCi Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (GHCiOption
opt GHCiOption -> [GHCiOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GHCiState -> [GHCiOption]
options GHCiState
st)

setOption :: GHCiOption -> GHCi ()
setOption :: GHCiOption -> GHCi ()
setOption opt :: GHCiOption
opt
 = do GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
      GHCiState -> GHCi ()
forall (m :: * -> *). HasGhciState m => GHCiState -> m ()
setGHCiState (GHCiState
st{ options :: [GHCiOption]
options = GHCiOption
opt GHCiOption -> [GHCiOption] -> [GHCiOption]
forall a. a -> [a] -> [a]
: (GHCiOption -> Bool) -> [GHCiOption] -> [GHCiOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (GHCiOption -> GHCiOption -> Bool
forall a. Eq a => a -> a -> Bool
/= GHCiOption
opt) (GHCiState -> [GHCiOption]
options GHCiState
st) })

unsetOption :: GHCiOption -> GHCi ()
unsetOption :: GHCiOption -> GHCi ()
unsetOption opt :: GHCiOption
opt
 = do GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
      GHCiState -> GHCi ()
forall (m :: * -> *). HasGhciState m => GHCiState -> m ()
setGHCiState (GHCiState
st{ options :: [GHCiOption]
options = (GHCiOption -> Bool) -> [GHCiOption] -> [GHCiOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (GHCiOption -> GHCiOption -> Bool
forall a. Eq a => a -> a -> Bool
/= GHCiOption
opt) (GHCiState -> [GHCiOption]
options GHCiState
st) })

printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
printForUserNeverQualify :: SDoc -> m ()
printForUserNeverQualify doc :: SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUser DynFlags
dflags Handle
stdout PrintUnqualified
neverQualify SDoc
doc

printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
printForUserModInfo :: ModuleInfo -> SDoc -> m ()
printForUserModInfo info :: ModuleInfo
info doc :: SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  Maybe PrintUnqualified
mUnqual <- ModuleInfo -> m (Maybe PrintUnqualified)
forall (m :: * -> *).
GhcMonad m =>
ModuleInfo -> m (Maybe PrintUnqualified)
GHC.mkPrintUnqualifiedForModule ModuleInfo
info
  PrintUnqualified
unqual <- m PrintUnqualified
-> (PrintUnqualified -> m PrintUnqualified)
-> Maybe PrintUnqualified
-> m PrintUnqualified
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m PrintUnqualified
forall (m :: * -> *). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual PrintUnqualified -> m PrintUnqualified
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PrintUnqualified
mUnqual
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUser DynFlags
dflags Handle
stdout PrintUnqualified
unqual SDoc
doc

printForUser :: GhcMonad m => SDoc -> m ()
printForUser :: SDoc -> m ()
printForUser doc :: SDoc
doc = do
  PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: * -> *). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
  DynFlags
dflags <- m DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUser DynFlags
dflags Handle
stdout PrintUnqualified
unqual SDoc
doc

printForUserPartWay :: SDoc -> GHCi ()
printForUserPartWay :: SDoc -> GHCi ()
printForUserPartWay doc :: SDoc
doc = do
  PrintUnqualified
unqual <- GHCi PrintUnqualified
forall (m :: * -> *). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
  DynFlags
dflags <- GHCi DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> GHCi ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUserPartWay DynFlags
dflags Handle
stdout (DynFlags -> Int
pprUserLength DynFlags
dflags) PrintUnqualified
unqual SDoc
doc

-- | Run a single Haskell expression
runStmt :: GhciLStmt GhcPs -> String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
runStmt :: GhciLStmt GhcPs -> String -> SingleStep -> GHCi (Maybe ExecResult)
runStmt stmt :: GhciLStmt GhcPs
stmt stmt_text :: String
stmt_text step :: SingleStep
step = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  (SourceError -> GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> GHCi (Maybe ExecResult)
forall (m :: * -> *) a.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\e :: SourceError
e -> do SourceError -> GHCi ()
forall (m :: * -> *). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e; Maybe ExecResult -> GHCi (Maybe ExecResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExecResult
forall a. Maybe a
Nothing) (GHCi (Maybe ExecResult) -> GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> GHCi (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$ do
    let opts :: ExecOptions
opts = ExecOptions
GHC.execOptions
                  { execSourceFile :: String
GHC.execSourceFile = GHCiState -> String
progname GHCiState
st
                  , execLineNumber :: Int
GHC.execLineNumber = GHCiState -> Int
line_number GHCiState
st
                  , execSingleStep :: SingleStep
GHC.execSingleStep = SingleStep
step
                  , execWrap :: ForeignHValue -> EvalExpr ForeignHValue
GHC.execWrap = \fhv :: ForeignHValue
fhv -> EvalExpr ForeignHValue
-> EvalExpr ForeignHValue -> EvalExpr ForeignHValue
forall a. EvalExpr a -> EvalExpr a -> EvalExpr a
EvalApp (ForeignHValue -> EvalExpr ForeignHValue
forall a. a -> EvalExpr a
EvalThis (GHCiState -> ForeignHValue
evalWrapper GHCiState
st))
                                                   (ForeignHValue -> EvalExpr ForeignHValue
forall a. a -> EvalExpr a
EvalThis ForeignHValue
fhv) }
    ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just (ExecResult -> Maybe ExecResult)
-> GHCi ExecResult -> GHCi (Maybe ExecResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhciLStmt GhcPs -> String -> ExecOptions -> GHCi ExecResult
forall (m :: * -> *).
GhcMonad m =>
GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
GHC.execStmt' GhciLStmt GhcPs
stmt String
stmt_text ExecOptions
opts

runDecls :: String -> GHCi (Maybe [GHC.Name])
runDecls :: String -> GHCi (Maybe [Name])
runDecls decls :: String
decls = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name])
forall a. ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi (((Session, IORef GHCiState) -> IO (Maybe [Name]))
 -> GHCi (Maybe [Name]))
-> ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ \x :: (Session, IORef GHCiState)
x ->
    String -> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a. String -> IO a -> IO a
withProgName (GHCiState -> String
progname GHCiState
st) (IO (Maybe [Name]) -> IO (Maybe [Name]))
-> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$
    [String] -> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a. [String] -> IO a -> IO a
withArgs (GHCiState -> [String]
args GHCiState
st) (IO (Maybe [Name]) -> IO (Maybe [Name]))
-> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$
      (Session, IORef GHCiState)
-> GHCi (Maybe [Name]) -> IO (Maybe [Name])
forall a. (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi (Session, IORef GHCiState)
x (GHCi (Maybe [Name]) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ do
        (SourceError -> GHCi (Maybe [Name]))
-> GHCi (Maybe [Name]) -> GHCi (Maybe [Name])
forall (m :: * -> *) a.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\e :: SourceError
e -> do SourceError -> GHCi ()
forall (m :: * -> *). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e;
                                        Maybe [Name] -> GHCi (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing) (GHCi (Maybe [Name]) -> GHCi (Maybe [Name]))
-> GHCi (Maybe [Name]) -> GHCi (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ do
          [Name]
r <- String -> Int -> String -> GHCi [Name]
forall (m :: * -> *).
GhcMonad m =>
String -> Int -> String -> m [Name]
GHC.runDeclsWithLocation (GHCiState -> String
progname GHCiState
st) (GHCiState -> Int
line_number GHCiState
st) String
decls
          Maybe [Name] -> GHCi (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
r)

runDecls' :: [LHsDecl GhcPs] -> GHCi (Maybe [GHC.Name])
runDecls' :: [LHsDecl GhcPs] -> GHCi (Maybe [Name])
runDecls' decls :: [LHsDecl GhcPs]
decls = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name])
forall a. ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi (((Session, IORef GHCiState) -> IO (Maybe [Name]))
 -> GHCi (Maybe [Name]))
-> ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ \x :: (Session, IORef GHCiState)
x ->
    String -> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a. String -> IO a -> IO a
withProgName (GHCiState -> String
progname GHCiState
st) (IO (Maybe [Name]) -> IO (Maybe [Name]))
-> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$
    [String] -> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a. [String] -> IO a -> IO a
withArgs (GHCiState -> [String]
args GHCiState
st) (IO (Maybe [Name]) -> IO (Maybe [Name]))
-> IO (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$
    (Session, IORef GHCiState)
-> GHCi (Maybe [Name]) -> IO (Maybe [Name])
forall a. (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi (Session, IORef GHCiState)
x (GHCi (Maybe [Name]) -> IO (Maybe [Name]))
-> GHCi (Maybe [Name]) -> IO (Maybe [Name])
forall a b. (a -> b) -> a -> b
$
      (SourceError -> GHCi (Maybe [Name]))
-> GHCi (Maybe [Name]) -> GHCi (Maybe [Name])
forall (m :: * -> *) a.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError
        (\e :: SourceError
e -> do SourceError -> GHCi ()
forall (m :: * -> *). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e;
                  Maybe [Name] -> GHCi (Maybe [Name])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Name]
forall a. Maybe a
Nothing)
        ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just ([Name] -> Maybe [Name]) -> GHCi [Name] -> GHCi (Maybe [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> GHCi [Name]
forall (m :: * -> *). GhcMonad m => [LHsDecl GhcPs] -> m [Name]
GHC.runParsedDecls [LHsDecl GhcPs]
decls)

resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.ExecResult
resume :: (SrcSpan -> Bool) -> SingleStep -> GHCi ExecResult
resume canLogSpan :: SrcSpan -> Bool
canLogSpan step :: SingleStep
step = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO ExecResult) -> GHCi ExecResult
forall a. ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi (((Session, IORef GHCiState) -> IO ExecResult) -> GHCi ExecResult)
-> ((Session, IORef GHCiState) -> IO ExecResult) -> GHCi ExecResult
forall a b. (a -> b) -> a -> b
$ \x :: (Session, IORef GHCiState)
x ->
    String -> IO ExecResult -> IO ExecResult
forall a. String -> IO a -> IO a
withProgName (GHCiState -> String
progname GHCiState
st) (IO ExecResult -> IO ExecResult) -> IO ExecResult -> IO ExecResult
forall a b. (a -> b) -> a -> b
$
    [String] -> IO ExecResult -> IO ExecResult
forall a. [String] -> IO a -> IO a
withArgs (GHCiState -> [String]
args GHCiState
st) (IO ExecResult -> IO ExecResult) -> IO ExecResult -> IO ExecResult
forall a b. (a -> b) -> a -> b
$
      (Session, IORef GHCiState) -> GHCi ExecResult -> IO ExecResult
forall a. (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi (Session, IORef GHCiState)
x (GHCi ExecResult -> IO ExecResult)
-> GHCi ExecResult -> IO ExecResult
forall a b. (a -> b) -> a -> b
$ do
        (SrcSpan -> Bool) -> SingleStep -> GHCi ExecResult
forall (m :: * -> *).
GhcMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ExecResult
GHC.resumeExec SrcSpan -> Bool
canLogSpan SingleStep
step

-- --------------------------------------------------------------------------
-- timing & statistics

data ActionStats = ActionStats
  { ActionStats -> Maybe Integer
actionAllocs :: Maybe Integer
  , ActionStats -> Double
actionElapsedTime :: Double
  } deriving Int -> ActionStats -> ShowS
[ActionStats] -> ShowS
ActionStats -> String
(Int -> ActionStats -> ShowS)
-> (ActionStats -> String)
-> ([ActionStats] -> ShowS)
-> Show ActionStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionStats] -> ShowS
$cshowList :: [ActionStats] -> ShowS
show :: ActionStats -> String
$cshow :: ActionStats -> String
showsPrec :: Int -> ActionStats -> ShowS
$cshowsPrec :: Int -> ActionStats -> ShowS
Show

runAndPrintStats
  :: (a -> Maybe Integer)
  -> InputT GHCi a
  -> InputT GHCi (ActionStats, Either SomeException a)
runAndPrintStats :: (a -> Maybe Integer)
-> InputT GHCi a
-> InputT GHCi (ActionStats, Either SomeException a)
runAndPrintStats getAllocs :: a -> Maybe Integer
getAllocs action :: InputT GHCi a
action = do
  (ActionStats, Either SomeException a)
result <- (a -> Maybe Integer)
-> InputT GHCi a
-> InputT GHCi (ActionStats, Either SomeException a)
forall (m :: * -> *) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats a -> Maybe Integer
getAllocs InputT GHCi a
action
  case (ActionStats, Either SomeException a)
result of
    (stats :: ActionStats
stats, Right{}) -> do
      Bool
showTiming <- GHCi Bool -> InputT GHCi Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool) -> GHCi Bool -> InputT GHCi Bool
forall a b. (a -> b) -> a -> b
$ GHCiOption -> GHCi Bool
isOptionSet GHCiOption
ShowTiming
      Bool -> InputT GHCi () -> InputT GHCi ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showTiming (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ do
        DynFlags
dflags  <- InputT GHCi DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        IO () -> InputT GHCi ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> ActionStats -> IO ()
printStats DynFlags
dflags ActionStats
stats
    _ -> () -> InputT GHCi ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (ActionStats, Either SomeException a)
-> InputT GHCi (ActionStats, Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionStats, Either SomeException a)
result

runWithStats
  :: ExceptionMonad m
  => (a -> Maybe Integer) -> m a -> m (ActionStats, Either SomeException a)
runWithStats :: (a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats getAllocs :: a -> Maybe Integer
getAllocs action :: m a
action = do
  UTCTime
t0 <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Either SomeException a
result <- m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> m (Either e a)
gtry m a
action
  let allocs :: Maybe Integer
allocs = (SomeException -> Maybe Integer)
-> (a -> Maybe Integer) -> Either SomeException a -> Maybe Integer
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Integer -> SomeException -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) a -> Maybe Integer
getAllocs Either SomeException a
result
  UTCTime
t1 <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let elapsedTime :: Double
elapsedTime = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ UTCTime
t1 UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
t0
  (ActionStats, Either SomeException a)
-> m (ActionStats, Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> Double -> ActionStats
ActionStats Maybe Integer
allocs Double
elapsedTime, Either SomeException a
result)

printStats :: DynFlags -> ActionStats -> IO ()
printStats :: DynFlags -> ActionStats -> IO ()
printStats dflags :: DynFlags
dflags ActionStats{actionAllocs :: ActionStats -> Maybe Integer
actionAllocs = Maybe Integer
mallocs, actionElapsedTime :: ActionStats -> Double
actionElapsedTime = Double
secs}
   = do let secs_str :: ShowS
secs_str = Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just 2) Double
secs
        String -> IO ()
putStrLn (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (
                 SDoc -> SDoc
parens (String -> SDoc
text (ShowS
secs_str "") SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "secs" SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
                         case Maybe Integer
mallocs of
                           Nothing -> SDoc
empty
                           Just allocs :: Integer
allocs ->
                             String -> SDoc
text (Integer -> String
forall a. Show a => a -> String
separateThousands Integer
allocs) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "bytes")))
  where
    separateThousands :: a -> String
separateThousands n :: a
n = ShowS
forall a. [a] -> [a]
reverse ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sep ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
n
      where sep :: ShowS
sep n' :: String
n'
              | String
n' String -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthAtMost` 3 = String
n'
              | Bool
otherwise           = Int -> ShowS
forall a. Int -> [a] -> [a]
take 3 String
n' String -> ShowS
forall a. [a] -> [a] -> [a]
++ "," String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
sep (Int -> ShowS
forall a. Int -> [a] -> [a]
drop 3 String
n')

-----------------------------------------------------------------------------
-- reverting CAFs

revertCAFs :: GHCi ()
revertCAFs :: GHCi ()
revertCAFs = do
  IO () -> GHCi ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
rts_revertCAFs
  GHCiState
s <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  Bool -> GHCi () -> GHCi ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (GHCiState -> Bool
ghc_e GHCiState
s)) GHCi ()
turnOffBuffering
     -- Have to turn off buffering again, because we just
     -- reverted stdout, stderr & stdin to their defaults.

foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()
        -- Make it "safe", just in case

-----------------------------------------------------------------------------
-- To flush buffers for the *interpreted* computation we need
-- to refer to *its* stdout/stderr handles

-- | Compile "hFlush stdout; hFlush stderr" once, so we can use it repeatedly
initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
initInterpBuffering :: Ghc (ForeignHValue, ForeignHValue)
initInterpBuffering = do
  let mkHelperExpr :: OccName -> Ghc ForeignHValue
      mkHelperExpr :: OccName -> Ghc ForeignHValue
mkHelperExpr occ :: OccName
occ =
        LHsExpr GhcPs -> Ghc ForeignHValue
forall (m :: * -> *).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote
        (LHsExpr GhcPs -> Ghc ForeignHValue)
-> LHsExpr GhcPs -> Ghc ForeignHValue
forall a b. (a -> b) -> a -> b
$ IdP GhcPs -> LHsExpr GhcPs
forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
GHC.nlHsVar (IdP GhcPs -> LHsExpr GhcPs) -> IdP GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> RdrName
RdrName.mkOrig Module
gHC_GHCI_HELPERS OccName
occ
  ForeignHValue
nobuf <- OccName -> Ghc ForeignHValue
mkHelperExpr (OccName -> Ghc ForeignHValue) -> OccName -> Ghc ForeignHValue
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc "disableBuffering"
  ForeignHValue
flush <- OccName -> Ghc ForeignHValue
mkHelperExpr (OccName -> Ghc ForeignHValue) -> OccName -> Ghc ForeignHValue
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc "flushAll"
  (ForeignHValue, ForeignHValue)
-> Ghc (ForeignHValue, ForeignHValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignHValue
nobuf, ForeignHValue
flush)

-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
flushInterpBuffers :: GHCi ()
flushInterpBuffers :: GHCi ()
flushInterpBuffers = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  HscEnv
hsc_env <- GHCi HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
  IO () -> GHCi ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> ForeignHValue -> IO ()
evalIO HscEnv
hsc_env (GHCiState -> ForeignHValue
flushStdHandles GHCiState
st)

-- | Turn off buffering for stdin, stdout, and stderr in the interpreter
turnOffBuffering :: GHCi ()
turnOffBuffering :: GHCi ()
turnOffBuffering = do
  GHCiState
st <- GHCi GHCiState
forall (m :: * -> *). HasGhciState m => m GHCiState
getGHCiState
  ForeignHValue -> GHCi ()
forall (m :: * -> *). GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ (GHCiState -> ForeignHValue
noBuffering GHCiState
st)

turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ :: ForeignHValue -> m ()
turnOffBuffering_ fhv :: ForeignHValue
fhv = do
  HscEnv
hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> ForeignHValue -> IO ()
evalIO HscEnv
hsc_env ForeignHValue
fhv

mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
mkEvalWrapper :: String -> [String] -> m ForeignHValue
mkEvalWrapper progname :: String
progname args :: [String]
args =
  m ForeignHValue -> m ForeignHValue
forall (m :: * -> *) a. GhcMonad m => m a -> m a
runInternal (m ForeignHValue -> m ForeignHValue)
-> m ForeignHValue -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> m ForeignHValue
forall (m :: * -> *).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote
  (LHsExpr GhcPs -> m ForeignHValue)
-> LHsExpr GhcPs -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs
evalWrapper LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`GHC.mkHsApp` String -> LHsExpr GhcPs
forall (p :: Pass). String -> LHsExpr (GhcPass p)
nlHsString String
progname
                LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`GHC.mkHsApp` [LHsExpr GhcPs] -> LHsExpr GhcPs
nlList ((String -> LHsExpr GhcPs) -> [String] -> [LHsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map String -> LHsExpr GhcPs
forall (p :: Pass). String -> LHsExpr (GhcPass p)
nlHsString [String]
args)
  where
    nlHsString :: String -> LHsExpr (GhcPass p)
nlHsString = HsLit (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (HsLit (GhcPass p) -> LHsExpr (GhcPass p))
-> (String -> HsLit (GhcPass p)) -> String -> LHsExpr (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass p)
forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString
    evalWrapper :: LHsExpr GhcPs
evalWrapper =
      IdP GhcPs -> LHsExpr GhcPs
forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
GHC.nlHsVar (IdP GhcPs -> LHsExpr GhcPs) -> IdP GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Module -> OccName -> RdrName
RdrName.mkOrig Module
gHC_GHCI_HELPERS (String -> OccName
mkVarOcc "evalWrapper")

-- | Run a 'GhcMonad' action to compile an expression for internal usage.
runInternal :: GhcMonad m => m a -> m a
runInternal :: m a -> m a
runInternal =
    (HscEnv -> HscEnv) -> m a -> m a
forall (m :: * -> *) a.
GhcMonad m =>
(HscEnv -> HscEnv) -> m a -> m a
withTempSession HscEnv -> HscEnv
mkTempSession
  where
    mkTempSession :: HscEnv -> HscEnv
mkTempSession hsc_env :: HscEnv
hsc_env = HscEnv
hsc_env
      { hsc_dflags :: DynFlags
hsc_dflags = (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
          -- RebindableSyntax can wreak havoc with GHCi in several ways
          -- (see #13385 and #14342 for examples), so we take care to disable it
          -- for the duration of running expressions that are internal to GHCi.
          DynFlags -> Extension -> DynFlags
`xopt_unset` Extension
LangExt.RebindableSyntax
          -- We heavily depend on -fimplicit-import-qualified to compile expr
          -- with fully qualified names without imports.
          DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
      }

compileGHCiExpr :: GhcMonad m => String -> m ForeignHValue
compileGHCiExpr :: String -> m ForeignHValue
compileGHCiExpr expr :: String
expr = m ForeignHValue -> m ForeignHValue
forall (m :: * -> *) a. GhcMonad m => m a -> m a
runInternal (m ForeignHValue -> m ForeignHValue)
-> m ForeignHValue -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$ String -> m ForeignHValue
forall (m :: * -> *). GhcMonad m => String -> m ForeignHValue
GHC.compileExprRemote String
expr