{-# LANGUAGE FlexibleInstances, DeriveFunctor, DerivingVia #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

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

module Clash.GHCi.UI.Monad (
        GHCi(..), startGHCi,
        GHCiState(..), GhciMonad(..),
        GHCiOption(..), isOptionSet, setOption, unsetOption,
        Command(..), CommandResult(..), cmdSuccess,
        CmdExecOutcome(..),
        LocalConfigBehaviour(..),
        PromptFunction,
        BreakLocation(..),
        TickArray,
        extractDynFlags, getDynFlags,

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

        printForUserNeverQualify, printForUserModInfo,
        printForUser, printForUserPartWay, prettyLocations,

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

import Clash.GHCi.UI.Info (ModInfo)
import qualified GHC
import GHC.Driver.Monad hiding (liftIO)
import GHC.Utils.Outputable
import qualified GHC.Driver.Ppr as Ppr
import GHC.Types.Name.Occurrence
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Driver.Env
import GHC.Types.SrcLoc
import GHC.Types.SafeHaskell
import GHC.Driver.Make (ModIfaceCache(..))
import GHC.Unit
import GHC.Types.Name.Reader as RdrName (mkOrig)
import GHC.Builtin.Names (gHC_GHCI_HELPERS)
import GHC.Runtime.Interpreter
import GHC.Runtime.Context
import GHCi.RemoteTypes
import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import GHC.Hs.Utils
import GHC.Utils.Misc
import GHC.Utils.Logger

import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
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 Control.Monad.Catch as MC
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
import qualified Data.IntMap.Strict as IntMap
import qualified GHC.Data.EnumSet as EnumSet
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 -> Bool
multiMode      :: Bool,
        GHCiState -> LocalConfigBehaviour
localConfig    :: LocalConfigBehaviour,
        GHCiState -> [GHCiOption]
options        :: [GHCiOption],
        GHCiState -> Int
line_number    :: !Int,         -- ^ input line
        GHCiState -> Int
break_ctr      :: !Int,
        GHCiState -> IntMap BreakLocation
breaks         :: !(IntMap.IntMap 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
        GHCiState -> ModIfaceCache
ifaceCache :: ModIfaceCache
     }

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 CmdExecOutcome
cmdAction         :: String -> InputT GHCi CmdExecOutcome
     -- ^ The 'CmdExecOutcome' value denotes whether to exit GHCi cleanly or error out
   , 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
   }

-- | Used to denote GHCi command execution result. Specifically, used to
-- distinguish between two ghci execution modes - "REPL" and "Expression
-- evaluation mode (ghc -e)". When in "REPL" mode, we don't want to exit
-- GHCi session when error occurs, (which is when we use "CmdSuccess").
-- Otherwise, when in expression evaluation mode, all command failures
-- should lead to GHCi session termination (with ExitFailure 1) which is
-- when "CmdFailure" is used(this is useful when executing scripts).
-- "CleanExit" is used to signal end of GHCi session (for example, when
-- ":quit" command is called).
data CmdExecOutcome
  = CleanExit
  | CmdSuccess
  | CmdFailure

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
$cshowsPrec :: Int -> CommandResult -> ShowS
showsPrec :: Int -> CommandResult -> ShowS
$cshow :: CommandResult -> String
show :: CommandResult -> String
$cshowList :: [CommandResult] -> ShowS
showList :: [CommandResult] -> ShowS
Show

cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
cmdSuccess :: forall (m :: Type -> Type).
MonadThrow m =>
CommandResult -> m (Maybe Bool)
cmdSuccess CommandComplete{ cmdResult :: CommandResult -> Either SomeException (Maybe Bool)
cmdResult = Left SomeException
e } = SomeException -> m (Maybe Bool)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
e
cmdSuccess CommandComplete{ cmdResult :: CommandResult -> Either SomeException (Maybe Bool)
cmdResult = Right Maybe Bool
r } = Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
r
cmdSuccess CommandResult
CommandIncomplete = Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (m :: Type -> Type) 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
$c== :: GHCiOption -> GHCiOption -> Bool
== :: GHCiOption -> GHCiOption -> Bool
$c/= :: GHCiOption -> GHCiOption -> Bool
/= :: GHCiOption -> GHCiOption -> Bool
Eq

-- | Treatment of ./.ghci files.  For now we either load or
-- ignore.  But later we could implement a "safe mode" where
-- only safe operations are performed.
--
data LocalConfigBehaviour
  = SourceLocalConfig
  | IgnoreLocalConfig
  deriving (LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
(LocalConfigBehaviour -> LocalConfigBehaviour -> Bool)
-> (LocalConfigBehaviour -> LocalConfigBehaviour -> Bool)
-> Eq LocalConfigBehaviour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
== :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
$c/= :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
/= :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
Eq)

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

instance Eq BreakLocation where
  BreakLocation
loc1 == :: BreakLocation -> BreakLocation -> Bool
== 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 :: IntMap.IntMap BreakLocation -> SDoc
prettyLocations :: IntMap BreakLocation -> SDoc
prettyLocations  IntMap BreakLocation
locs =
    case  IntMap BreakLocation -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap BreakLocation
locs of
      Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No active breakpoints."
      Bool
False -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
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 (\(Int
i, BreakLocation
loc) -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BreakLocation -> SDoc
forall a. Outputable a => a -> SDoc
ppr BreakLocation
loc) ([(Int, BreakLocation)] -> [SDoc])
-> [(Int, BreakLocation)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ IntMap BreakLocation -> [(Int, BreakLocation)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap BreakLocation
locs

instance Outputable BreakLocation where
   ppr :: BreakLocation -> SDoc
ppr 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
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BreakLocation -> SrcSpan
breakLoc BreakLocation
loc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pprEnaDisa SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                if String -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (BreakLocation -> String
onBreakCmd BreakLocation
loc)
                   then SDoc
forall doc. IsOutput doc => doc
empty
                   else SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text (BreakLocation -> String
onBreakCmd BreakLocation
loc))
      where pprEnaDisa :: SDoc
pprEnaDisa = case BreakLocation -> Bool
breakEnabled BreakLocation
loc of
                Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"enabled"
                Bool
False -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"disabled"

recordBreak
  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
recordBreak :: forall (m :: Type -> Type).
GhciMonad m =>
BreakLocation -> m (Bool, Int)
recordBreak BreakLocation
brkLoc = do
   GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
   let oldmap :: IntMap BreakLocation
oldmap = GHCiState -> IntMap BreakLocation
breaks GHCiState
st
       oldActiveBreaks :: [(Int, BreakLocation)]
oldActiveBreaks = IntMap BreakLocation -> [(Int, BreakLocation)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs IntMap BreakLocation
oldmap
   -- don't store the same break point twice
   case [ Int
nm | (Int
nm, BreakLocation
loc) <- [(Int, BreakLocation)]
oldActiveBreaks, BreakLocation
loc BreakLocation -> BreakLocation -> Bool
forall a. Eq a => a -> a -> Bool
== BreakLocation
brkLoc ] of
     (Int
nm:[Int]
_) -> (Bool, Int) -> m (Bool, Int)
forall a. a -> m a
forall (m :: Type -> Type) 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
+ Int
1
      GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState -> m ()) -> GHCiState -> m ()
forall a b. (a -> b) -> a -> b
$ GHCiState
st { break_ctr = newCounter,
                          breaks = IntMap.insert oldCounter brkLoc oldmap
                        }
      (Bool, Int) -> m (Bool, Int)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
False, Int
oldCounter)

newtype GHCi a = GHCi { forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi :: IORef GHCiState -> Ghc a }
    deriving ((forall a b. (a -> b) -> GHCi a -> GHCi b)
-> (forall a b. a -> GHCi b -> GHCi a) -> Functor GHCi
forall a b. a -> GHCi b -> GHCi a
forall a b. (a -> b) -> GHCi a -> GHCi b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GHCi a -> GHCi b
fmap :: forall a b. (a -> b) -> GHCi a -> GHCi b
$c<$ :: forall a b. a -> GHCi b -> GHCi a
<$ :: forall a b. a -> GHCi b -> GHCi a
Functor)
    deriving (Monad GHCi
Monad GHCi =>
(forall e a. (HasCallStack, Exception e) => e -> GHCi a)
-> MonadThrow GHCi
forall e a. (HasCallStack, Exception e) => e -> GHCi a
forall (m :: Type -> Type).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> GHCi a
throwM :: forall e a. (HasCallStack, Exception e) => e -> GHCi a
MonadThrow, MonadThrow GHCi
MonadThrow GHCi =>
(forall e a.
 (HasCallStack, Exception e) =>
 GHCi a -> (e -> GHCi a) -> GHCi a)
-> MonadCatch GHCi
forall e a.
(HasCallStack, Exception e) =>
GHCi a -> (e -> GHCi a) -> GHCi a
forall (m :: Type -> Type).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
GHCi a -> (e -> GHCi a) -> GHCi a
catch :: forall e a.
(HasCallStack, Exception e) =>
GHCi a -> (e -> GHCi a) -> GHCi a
MonadCatch, MonadCatch GHCi
MonadCatch GHCi =>
(forall b.
 HasCallStack =>
 ((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b)
-> (forall b.
    HasCallStack =>
    ((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b)
-> (forall a b c.
    HasCallStack =>
    GHCi a
    -> (a -> ExitCase b -> GHCi c) -> (a -> GHCi b) -> GHCi (b, c))
-> MonadMask GHCi
forall b.
HasCallStack =>
((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
forall a b c.
HasCallStack =>
GHCi a
-> (a -> ExitCase b -> GHCi c) -> (a -> GHCi b) -> GHCi (b, c)
forall (m :: Type -> Type).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
mask :: forall b.
HasCallStack =>
((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
$cgeneralBracket :: forall a b c.
HasCallStack =>
GHCi a
-> (a -> ExitCase b -> GHCi c) -> (a -> GHCi b) -> GHCi (b, c)
generalBracket :: forall a b c.
HasCallStack =>
GHCi a
-> (a -> ExitCase b -> GHCi c) -> (a -> GHCi b) -> GHCi (b, c)
MonadMask) via (ReaderT (IORef GHCiState) Ghc)

reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi :: forall a. (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi (Session
s, IORef GHCiState
gs) 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

startGHCi :: GHCi a -> GHCiState -> Ghc a
startGHCi :: forall a. GHCi a -> GHCiState -> Ghc a
startGHCi GHCi a
g GHCiState
state = do IORef GHCiState
ref <- IO (IORef GHCiState) -> Ghc (IORef GHCiState)
forall a. IO a -> Ghc a
forall (m :: Type -> Type) 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 Applicative GHCi where
    pure :: forall a. a -> GHCi a
pure 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
$ \IORef GHCiState
_ -> a -> Ghc a
forall a. a -> Ghc a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
    <*> :: forall a b. GHCi (a -> b) -> GHCi a -> GHCi b
(<*>) = GHCi (a -> b) -> GHCi a -> GHCi b
forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad GHCi where
  (GHCi IORef GHCiState -> Ghc a
m) >>= :: forall a b. GHCi a -> (a -> GHCi b) -> GHCi b
>>= 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
$ \IORef GHCiState
s -> IORef GHCiState -> Ghc a
m IORef GHCiState
s Ghc a -> (a -> Ghc b) -> Ghc b
forall a b. Ghc a -> (a -> Ghc b) -> Ghc b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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 GhcMonad m => GhciMonad m where
  getGHCiState    :: m GHCiState
  setGHCiState    :: GHCiState -> m ()
  modifyGHCiState :: (GHCiState -> GHCiState) -> m ()
  reifyGHCi       :: ((Session, IORef GHCiState) -> IO a) -> m a

instance GhciMonad 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
$ \IORef GHCiState
r -> IO GHCiState -> Ghc GHCiState
forall a. IO a -> Ghc a
forall (m :: Type -> Type) 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 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
$ \IORef GHCiState
r -> IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) 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 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
$ \IORef GHCiState
r -> IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) 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
  reifyGHCi :: forall a. ((Session, IORef GHCiState) -> IO a) -> GHCi a
reifyGHCi (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) -> GHCi a)
-> (IORef GHCiState -> Ghc a) -> GHCi a
forall a b. (a -> b) -> a -> b
$ \IORef GHCiState
r -> (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
reifyGhc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \Session
s -> (Session, IORef GHCiState) -> IO a
f (Session
s, IORef GHCiState
r)

instance GhciMonad (InputT GHCi) where
  getGHCiState :: InputT GHCi GHCiState
getGHCiState    = GHCi GHCiState -> InputT GHCi GHCiState
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  setGHCiState :: GHCiState -> InputT GHCi ()
setGHCiState    = GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> (GHCiState -> GHCi ()) -> GHCiState -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCiState -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState
  modifyGHCiState :: (GHCiState -> GHCiState) -> InputT GHCi ()
modifyGHCiState = GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> ((GHCiState -> GHCiState) -> GHCi ())
-> (GHCiState -> GHCiState)
-> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCiState -> GHCiState) -> GHCi ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState
  reifyGHCi :: forall a. ((Session, IORef GHCiState) -> IO a) -> InputT GHCi a
reifyGHCi       = GHCi a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi a -> InputT GHCi a)
-> (((Session, IORef GHCiState) -> IO a) -> GHCi a)
-> ((Session, IORef GHCiState) -> IO a)
-> InputT GHCi a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Session, IORef GHCiState) -> IO a) -> GHCi a
forall a. ((Session, IORef GHCiState) -> IO a) -> GHCi a
forall (m :: Type -> Type) a.
GhciMonad m =>
((Session, IORef GHCiState) -> IO a) -> m a
reifyGHCi

liftGhc :: Ghc a -> GHCi a
liftGhc :: forall a. Ghc a -> GHCi a
liftGhc 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
$ \IORef GHCiState
_ -> Ghc a
m

instance MonadIO GHCi where
  liftIO :: forall a. 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 a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO

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

instance HasLogger GHCi where
  getLogger :: GHCi Logger
getLogger = HscEnv -> Logger
hsc_logger (HscEnv -> Logger) -> GHCi HscEnv -> GHCi Logger
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCi HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
getSession

instance GhcMonad GHCi where
  setSession :: HscEnv -> GHCi ()
setSession 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 :: Type -> Type). 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 :: Type -> Type). GhcMonad m => m HscEnv
getSession


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

instance HasLogger (InputT GHCi) where
  getLogger :: InputT GHCi Logger
getLogger = GHCi Logger -> InputT GHCi Logger
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi Logger
forall (m :: Type -> Type). HasLogger m => m Logger
getLogger

instance GhcMonad (InputT GHCi) where
  setSession :: HscEnv -> InputT GHCi ()
setSession = GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) 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 :: Type -> Type). GhcMonad m => HscEnv -> m ()
setSession
  getSession :: InputT GHCi HscEnv
getSession = GHCi HscEnv -> InputT GHCi HscEnv
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
getSession

isOptionSet :: GhciMonad m => GHCiOption -> m Bool
isOptionSet :: forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
opt
 = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! (GHCiOption
opt GHCiOption -> [GHCiOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` GHCiState -> [GHCiOption]
options GHCiState
st)

setOption :: GhciMonad m => GHCiOption -> m ()
setOption :: forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m ()
setOption GHCiOption
opt
 = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState
st{ options = opt : filter (/= opt) (options st) })

unsetOption :: GhciMonad m => GHCiOption -> m ()
unsetOption :: forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m ()
unsetOption GHCiOption
opt
 = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState
st{ options = filter (/= opt) (options st) })

printForUserNeverQualify :: GhcMonad m => SDoc -> m ()
printForUserNeverQualify :: forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUserNeverQualify SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
Ppr.printForUser DynFlags
dflags Handle
stdout NamePprCtx
neverQualify Depth
AllTheWay SDoc
doc

printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
printForUserModInfo :: forall (m :: Type -> Type).
GhcMonad m =>
ModuleInfo -> SDoc -> m ()
printForUserModInfo ModuleInfo
info SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
  Maybe NamePprCtx
m_name_ppr_ctx <- ModuleInfo -> m (Maybe NamePprCtx)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleInfo -> m (Maybe NamePprCtx)
GHC.mkNamePprCtxForModule ModuleInfo
info
  NamePprCtx
name_ppr_ctx <- m NamePprCtx
-> (NamePprCtx -> m NamePprCtx) -> Maybe NamePprCtx -> m NamePprCtx
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m NamePprCtx
forall (m :: Type -> Type). GhcMonad m => m NamePprCtx
GHC.getNamePprCtx NamePprCtx -> m NamePprCtx
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe NamePprCtx
m_name_ppr_ctx
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
Ppr.printForUser DynFlags
dflags Handle
stdout NamePprCtx
name_ppr_ctx Depth
AllTheWay SDoc
doc

printForUser :: GhcMonad m => SDoc -> m ()
printForUser :: forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser SDoc
doc = do
  NamePprCtx
name_ppr_ctx <- m NamePprCtx
forall (m :: Type -> Type). GhcMonad m => m NamePprCtx
GHC.getNamePprCtx
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
Ppr.printForUser DynFlags
dflags Handle
stdout NamePprCtx
name_ppr_ctx Depth
AllTheWay SDoc
doc

printForUserPartWay :: GhcMonad m => SDoc -> m ()
printForUserPartWay :: forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUserPartWay SDoc
doc = do
  NamePprCtx
name_ppr_ctx <- m NamePprCtx
forall (m :: Type -> Type). GhcMonad m => m NamePprCtx
GHC.getNamePprCtx
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO ()
Ppr.printForUser DynFlags
dflags Handle
stdout NamePprCtx
name_ppr_ctx Depth
DefaultDepth SDoc
doc

-- | Run a single Haskell expression
runStmt
  :: GhciMonad m
  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)
runStmt :: forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> String -> SingleStep -> m (Maybe ExecResult)
runStmt GhciLStmt GhcPs
stmt String
stmt_text SingleStep
step = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  (SourceError -> m (Maybe ExecResult))
-> m (Maybe ExecResult) -> m (Maybe ExecResult)
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\SourceError
e -> do SourceError -> m ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException SourceError
e; Maybe ExecResult -> m (Maybe ExecResult)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
forall a. Maybe a
Nothing) (m (Maybe ExecResult) -> m (Maybe ExecResult))
-> m (Maybe ExecResult) -> m (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$ do
    let opts :: ExecOptions
opts = ExecOptions
GHC.execOptions
                  { GHC.execSourceFile = progname st
                  , GHC.execLineNumber = line_number st
                  , GHC.execSingleStep = step
                  , GHC.execWrap = \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)
-> m ExecResult -> m (Maybe ExecResult)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
forall (m :: Type -> Type).
GhcMonad m =>
GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
GHC.execStmt' GhciLStmt GhcPs
stmt String
stmt_text ExecOptions
opts

runDecls :: GhciMonad m => String -> m (Maybe [GHC.Name])
runDecls :: forall (m :: Type -> Type).
GhciMonad m =>
String -> m (Maybe [Name])
runDecls String
decls = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> m (Maybe [Name])
forall a. ((Session, IORef GHCiState) -> IO a) -> m a
forall (m :: Type -> Type) a.
GhciMonad m =>
((Session, IORef GHCiState) -> IO a) -> m a
reifyGHCi (((Session, IORef GHCiState) -> IO (Maybe [Name]))
 -> m (Maybe [Name]))
-> ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> m (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ \(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 :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\SourceError
e -> do SourceError -> GHCi ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException SourceError
e;
                                        Maybe [Name] -> GHCi (Maybe [Name])
forall a. a -> GHCi a
forall (m :: Type -> Type) 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 :: Type -> Type).
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 a. a -> GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
r)

runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name])
runDecls' :: forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe [Name])
runDecls' [LHsDecl GhcPs]
decls = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> m (Maybe [Name])
forall a. ((Session, IORef GHCiState) -> IO a) -> m a
forall (m :: Type -> Type) a.
GhciMonad m =>
((Session, IORef GHCiState) -> IO a) -> m a
reifyGHCi (((Session, IORef GHCiState) -> IO (Maybe [Name]))
 -> m (Maybe [Name]))
-> ((Session, IORef GHCiState) -> IO (Maybe [Name]))
-> m (Maybe [Name])
forall a b. (a -> b) -> a -> b
$ \(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 :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError
        (\SourceError
e -> do SourceError -> GHCi ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException SourceError
e;
                  Maybe [Name] -> GHCi (Maybe [Name])
forall a. a -> GHCi a
forall (m :: Type -> Type) 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 :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsDecl GhcPs] -> GHCi [Name]
forall (m :: Type -> Type).
GhcMonad m =>
[LHsDecl GhcPs] -> m [Name]
GHC.runParsedDecls [LHsDecl GhcPs]
decls)

resume :: GhciMonad m => (SrcSpan -> Bool) -> GHC.SingleStep -> Maybe Int -> m GHC.ExecResult
resume :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
resume SrcSpan -> Bool
canLogSpan SingleStep
step Maybe Int
mbIgnoreCnt = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO ExecResult) -> m ExecResult
forall a. ((Session, IORef GHCiState) -> IO a) -> m a
forall (m :: Type -> Type) a.
GhciMonad m =>
((Session, IORef GHCiState) -> IO a) -> m a
reifyGHCi (((Session, IORef GHCiState) -> IO ExecResult) -> m ExecResult)
-> ((Session, IORef GHCiState) -> IO ExecResult) -> m ExecResult
forall a b. (a -> b) -> a -> b
$ \(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 -> Maybe Int -> GHCi ExecResult
forall (m :: Type -> Type).
GhcMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
GHC.resumeExec SrcSpan -> Bool
canLogSpan SingleStep
step Maybe Int
mbIgnoreCnt

-- --------------------------------------------------------------------------
-- 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
$cshowsPrec :: Int -> ActionStats -> ShowS
showsPrec :: Int -> ActionStats -> ShowS
$cshow :: ActionStats -> String
show :: ActionStats -> String
$cshowList :: [ActionStats] -> ShowS
showList :: [ActionStats] -> ShowS
Show

runAndPrintStats
  :: GhciMonad m
  => (a -> Maybe Integer)
  -> m a
  -> m (ActionStats, Either SomeException a)
runAndPrintStats :: forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runAndPrintStats a -> Maybe Integer
getAllocs m a
action = do
  (ActionStats, Either SomeException a)
result <- (a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
forall (m :: Type -> Type) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats a -> Maybe Integer
getAllocs m a
action
  case (ActionStats, Either SomeException a)
result of
    (ActionStats
stats, Right{}) -> do
      Bool
showTiming <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
ShowTiming
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
showTiming (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        DynFlags
dflags  <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
        IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> ActionStats -> IO ()
printStats DynFlags
dflags ActionStats
stats
    (ActionStats, Either SomeException a)
_ -> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
  (ActionStats, Either SomeException a)
-> m (ActionStats, Either SomeException a)
forall a. a -> m a
forall (m :: Type -> Type) 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 :: forall (m :: Type -> Type) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats a -> Maybe Integer
getAllocs m a
action = do
  UTCTime
t0 <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Either SomeException a
result <- m a -> m (Either SomeException a)
forall (m :: Type -> Type) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try 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 a. IO a -> m a
forall (m :: Type -> Type) 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 a. a -> m a
forall (m :: Type -> Type) 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 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 Int
2) Double
secs
        String -> IO ()
putStrLn (DynFlags -> SDoc -> String
Ppr.showSDoc DynFlags
dflags (
                 SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text (ShowS
secs_str String
"") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"secs" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                         case Maybe Integer
mallocs of
                           Maybe Integer
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
                           Just Integer
allocs ->
                             String -> SDoc
forall doc. IsLine doc => String -> doc
text (Integer -> String
forall {p}. Show p => p -> String
separateThousands Integer
allocs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bytes")))
  where
    separateThousands :: p -> String
separateThousands p
n = ShowS
forall a. [a] -> [a]
reverse ShowS -> (p -> String) -> p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
separate ShowS -> (p -> String) -> p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> (p -> String) -> p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> String
forall {p}. Show p => p -> String
show (p -> String) -> p -> String
forall a b. (a -> b) -> a -> b
$ p
n
      where separate :: ShowS
separate String
n'
              | String
n' String -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthAtMost` Int
3 = String
n'
              | Bool
otherwise           = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 String
n' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
separate (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
n')

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

revertCAFs :: GhciMonad m => m ()
revertCAFs :: forall (m :: Type -> Type). GhciMonad m => m ()
revertCAFs = do
  Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> Message () -> IO ()
forall a. Binary a => Interp -> Message a -> IO a
interpCmd Interp
interp Message ()
RtsRevertCAFs
  GHCiState
s <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (GHCiState -> Bool
ghc_e GHCiState
s)) m ()
forall (m :: Type -> Type). GhciMonad m => m ()
turnOffBuffering
     -- Have to turn off buffering again, because we just
     -- reverted stdout, stderr & stdin to their defaults.


-----------------------------------------------------------------------------
-- 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 OccName
occ =
        LHsExpr GhcPs -> Ghc ForeignHValue
forall (m :: Type -> Type).
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 (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
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
$ FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"disableBuffering")
  ForeignHValue
flush <- OccName -> Ghc ForeignHValue
mkHelperExpr (OccName -> Ghc ForeignHValue) -> OccName -> Ghc ForeignHValue
forall a b. (a -> b) -> a -> b
$ FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"flushAll")
  (ForeignHValue, ForeignHValue)
-> Ghc (ForeignHValue, ForeignHValue)
forall a. a -> Ghc a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ForeignHValue
nobuf, ForeignHValue
flush)

-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
flushInterpBuffers :: GhciMonad m => m ()
flushInterpBuffers :: forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> ForeignHValue -> IO ()
evalIO Interp
interp (GHCiState -> ForeignHValue
flushStdHandles GHCiState
st)

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

turnOffBuffering_ :: GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ :: forall (m :: Type -> Type). GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ ForeignHValue
fhv = do
  Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
getSession
  IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> ForeignHValue -> IO ()
evalIO Interp
interp ForeignHValue
fhv

mkEvalWrapper :: GhcMonad m => String -> [String] ->  m ForeignHValue
mkEvalWrapper :: forall (m :: Type -> Type).
GhcMonad m =>
String -> [String] -> m ForeignHValue
mkEvalWrapper String
progname' [String]
args' =
  m ForeignHValue -> m ForeignHValue
forall (m :: Type -> Type) 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 :: Type -> Type).
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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
evalWrapper' LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`GHC.mkHsApp` String -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p :: Pass}.
String -> GenLocated SrcSpanAnnA (HsExpr (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 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [String] -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map String -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {p :: Pass}.
String -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
nlHsString [String]
args')
  where
    nlHsString :: String -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
nlHsString = HsLit (GhcPass p) -> LHsExpr (GhcPass p)
HsLit (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit (HsLit (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (String -> HsLit (GhcPass p))
-> String
-> GenLocated SrcSpanAnnA (HsExpr (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 (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
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 (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"evalWrapper"))

-- | Run a 'GhcMonad' action to compile an expression for internal usage.
runInternal :: GhcMonad m => m a -> m a
runInternal :: forall (m :: Type -> Type) a. GhcMonad m => m a -> m a
runInternal =
    (HscEnv -> HscEnv) -> m a -> m a
forall (m :: Type -> Type) a.
GhcMonad m =>
(HscEnv -> HscEnv) -> m a -> m a
withTempSession HscEnv -> HscEnv
mkTempSession
  where
    mkTempSession :: HscEnv -> HscEnv
mkTempSession = (DynFlags -> DynFlags) -> HscEnv -> HscEnv
hscUpdateFlags (\DynFlags
dflags -> DynFlags
dflags
      { -- Running GHCi's internal expression is incompatible with -XSafe.
          -- We temporarily disable any Safe Haskell settings while running
          -- GHCi internal expressions. (see #12509)
        safeHaskell = Sf_None,
          -- Disable dumping of any data during evaluation of GHCi's internal
          -- expressions. (#17500)
        dumpFlags = EnumSet.empty
      }
        -- RebindableSyntax can wreak havoc with GHCi in several ways
          -- (see #13385 and #14342 for examples), so we temporarily
          -- disable it too.
          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 :: forall (m :: Type -> Type). GhcMonad m => String -> m ForeignHValue
compileGHCiExpr String
expr = m ForeignHValue -> m ForeignHValue
forall (m :: Type -> Type) 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 :: Type -> Type). GhcMonad m => String -> m ForeignHValue
GHC.compileExprRemote String
expr