{-# LANGUAGE CPP, FlexibleInstances, DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-----------------------------------------------------------------------------
--
-- 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,
        LocalConfigBehaviour(..),
        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 GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import GHC.Hs.Utils
import Util

import 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
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Map.Strict (Map)
import qualified Data.IntMap.Strict as IntMap
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 -> 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
     }

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 :: MonadThrow m => CommandResult -> m (Maybe Bool)
cmdSuccess :: CommandResult -> m (Maybe Bool)
cmdSuccess CommandComplete{ cmdResult :: CommandResult -> Either SomeException (Maybe Bool)
cmdResult = Left SomeException
e } = SomeException -> m (Maybe Bool)
forall (m :: Type -> Type) e a.
(MonadThrow m, 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 (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
r
cmdSuccess CommandResult
CommandIncomplete = Maybe Bool -> m (Maybe Bool)
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
/= :: GHCiOption -> GHCiOption -> Bool
$c/= :: GHCiOption -> GHCiOption -> Bool
== :: GHCiOption -> GHCiOption -> Bool
$c== :: 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
/= :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
$c/= :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
== :: LocalConfigBehaviour -> LocalConfigBehaviour -> Bool
$c== :: 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
text String
"No active breakpoints."
      Bool
False -> [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 (\(Int
i, 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
$ 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
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BreakLocation -> SrcSpan
breakLoc BreakLocation
loc) SDoc -> SDoc -> SDoc
<+> SDoc
pprEnaDisa SDoc -> SDoc -> SDoc
<+>
                if String -> Bool
forall (t :: Type -> Type) 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))
      where pprEnaDisa :: SDoc
pprEnaDisa = case BreakLocation -> Bool
breakEnabled BreakLocation
loc of
                Bool
True  -> String -> SDoc
text String
"enabled"
                Bool
False -> String -> SDoc
text String
"disabled"

recordBreak
  :: GhciMonad m => BreakLocation -> m (Bool{- was already present -}, Int)
recordBreak :: 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 (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 :: Int
break_ctr = Int
newCounter,
                          breaks :: IntMap BreakLocation
breaks = Int
-> BreakLocation -> IntMap BreakLocation -> IntMap BreakLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
oldCounter BreakLocation
brkLoc IntMap BreakLocation
oldmap
                        }
      (Bool, Int) -> m (Bool, Int)
forall (m :: Type -> Type) 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 }
    deriving (a -> GHCi b -> GHCi a
(a -> b) -> GHCi a -> GHCi b
(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
<$ :: a -> GHCi b -> GHCi a
$c<$ :: forall a b. a -> GHCi b -> GHCi a
fmap :: (a -> b) -> GHCi a -> GHCi b
$cfmap :: forall a b. (a -> b) -> GHCi a -> GHCi b
Functor)

reflectGHCi :: (Session, IORef GHCiState) -> GHCi a -> IO a
reflectGHCi :: (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 :: GHCi a -> GHCiState -> Ghc a
startGHCi GHCi a
g GHCiState
state = do IORef GHCiState
ref <- IO (IORef GHCiState) -> Ghc (IORef GHCiState)
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 :: 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 (f :: Type -> Type) 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 :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad GHCi where
  (GHCi IORef GHCiState -> Ghc a
m) >>= :: 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 (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 (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 (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 (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 :: ((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 (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 (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 (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 :: ((Session, IORef GHCiState) -> IO a) -> InputT GHCi a
reifyGHCi       = GHCi a -> InputT GHCi 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 (m :: Type -> Type) a.
GhciMonad m =>
((Session, IORef GHCiState) -> IO a) -> m a
reifyGHCi

liftGhc :: Ghc a -> GHCi a
liftGhc :: 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 :: 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 :: 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 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 (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 GhcMonad (InputT GHCi) where
  setSession :: HscEnv -> InputT GHCi ()
setSession = GHCi () -> InputT GHCi ()
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 (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

instance ExceptionMonad GHCi where
  gcatch :: GHCi a -> (e -> GHCi a) -> GHCi a
gcatch GHCi a
m 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
$ \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 :: Type -> Type) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
`gcatch` (\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 (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
$ \IORef GHCiState
s -> ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall (m :: Type -> Type) 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
$ \Ghc a -> Ghc a
io_restore ->
                             let
                                g_restore :: GHCi a -> GHCi a
g_restore (GHCi 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
$ \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 MonadThrow Ghc where
  throwM :: e -> Ghc a
throwM = IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> Ghc a) -> (e -> IO a) -> e -> Ghc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM

instance MonadCatch Ghc where
  catch :: Ghc a -> (e -> Ghc a) -> Ghc a
catch = Ghc a -> (e -> Ghc a) -> Ghc a
forall (m :: Type -> Type) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
gcatch

instance MonadMask Ghc where
  mask :: ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
mask (forall a. Ghc a -> Ghc a) -> Ghc b
f = (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \Session
s ->
    ((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
io_restore ->
      let g_restore :: Ghc a -> Ghc a
g_restore (Ghc Session -> IO a
m) = (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
$ \Session
s -> IO a -> IO a
forall a. IO a -> IO a
io_restore (Session -> IO a
m Session
s)
      in Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc ((forall a. Ghc a -> Ghc a) -> Ghc b
f forall a. Ghc a -> Ghc a
g_restore) Session
s
  uninterruptibleMask :: ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
uninterruptibleMask (forall a. Ghc a -> Ghc a) -> Ghc b
f = (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \Session
s ->
    ((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
io_restore ->
      let g_restore :: Ghc a -> Ghc a
g_restore (Ghc Session -> IO a
m) = (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
$ \Session
s -> IO a -> IO a
forall a. IO a -> IO a
io_restore (Session -> IO a
m Session
s)
      in Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc ((forall a. Ghc a -> Ghc a) -> Ghc b
f forall a. Ghc a -> Ghc a
g_restore) Session
s
  generalBracket :: Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c)
generalBracket Ghc a
acquire a -> ExitCase b -> Ghc c
release a -> Ghc b
use = (Session -> IO (b, c)) -> Ghc (b, c)
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO (b, c)) -> Ghc (b, c))
-> (Session -> IO (b, c)) -> Ghc (b, c)
forall a b. (a -> b) -> a -> b
$ \Session
s ->
    IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c)
forall (m :: Type -> Type) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
acquire Session
s)
      (\a
resource ExitCase b
exitCase -> Ghc c -> Session -> IO c
forall a. Ghc a -> Session -> IO a
unGhc (a -> ExitCase b -> Ghc c
release a
resource ExitCase b
exitCase) Session
s)
      (\a
resource -> Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc (a -> Ghc b
use a
resource) Session
s)

instance MonadThrow GHCi where
  throwM :: e -> GHCi a
throwM = IO a -> GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> GHCi a) -> (e -> IO a) -> e -> GHCi a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM

instance MonadCatch GHCi where
  catch :: GHCi a -> (e -> GHCi a) -> GHCi a
catch = GHCi a -> (e -> GHCi a) -> GHCi a
forall (m :: Type -> Type) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
gcatch

instance MonadMask GHCi where
  mask :: ((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
mask (forall a. 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
$ \IORef GHCiState
s ->
    ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \forall a. Ghc a -> Ghc a
io_restore ->
      let g_restore :: GHCi a -> GHCi a
g_restore (GHCi 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
$ \IORef GHCiState
s -> Ghc a -> Ghc a
forall a. 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 ((forall a. GHCi a -> GHCi a) -> GHCi b
f forall a. GHCi a -> GHCi a
g_restore) IORef GHCiState
s
  uninterruptibleMask :: ((forall a. GHCi a -> GHCi a) -> GHCi b) -> GHCi b
uninterruptibleMask (forall a. 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
$ \IORef GHCiState
s ->
    ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b)
-> ((forall a. Ghc a -> Ghc a) -> Ghc b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \forall a. Ghc a -> Ghc a
io_restore ->
      let g_restore :: GHCi a -> GHCi a
g_restore (GHCi 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
$ \IORef GHCiState
s -> Ghc a -> Ghc a
forall a. 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 ((forall a. GHCi a -> GHCi a) -> GHCi b
f forall a. GHCi a -> GHCi a
g_restore) IORef GHCiState
s
  generalBracket :: GHCi a
-> (a -> ExitCase b -> GHCi c) -> (a -> GHCi b) -> GHCi (b, c)
generalBracket GHCi a
acquire a -> ExitCase b -> GHCi c
release a -> GHCi b
use = (IORef GHCiState -> Ghc (b, c)) -> GHCi (b, c)
forall a. (IORef GHCiState -> Ghc a) -> GHCi a
GHCi ((IORef GHCiState -> Ghc (b, c)) -> GHCi (b, c))
-> (IORef GHCiState -> Ghc (b, c)) -> GHCi (b, c)
forall a b. (a -> b) -> a -> b
$ \IORef GHCiState
s ->
    Ghc a -> (a -> ExitCase b -> Ghc c) -> (a -> Ghc b) -> Ghc (b, c)
forall (m :: Type -> Type) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (GHCi a -> IORef GHCiState -> Ghc a
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi GHCi a
acquire IORef GHCiState
s)
      (\a
resource ExitCase b
exitCase -> GHCi c -> IORef GHCiState -> Ghc c
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi (a -> ExitCase b -> GHCi c
release a
resource ExitCase b
exitCase) IORef GHCiState
s)
      (\a
resource -> GHCi b -> IORef GHCiState -> Ghc b
forall a. GHCi a -> IORef GHCiState -> Ghc a
unGHCi (a -> GHCi b
use a
resource) IORef GHCiState
s)

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 :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
  gmask :: ((InputT GHCi a -> InputT GHCi a) -> InputT GHCi b)
-> InputT GHCi b
gmask = ((InputT GHCi a -> InputT GHCi a) -> InputT GHCi b)
-> InputT GHCi b
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask

isOptionSet :: GhciMonad m => GHCiOption -> m Bool
isOptionSet :: GHCiOption -> m Bool
isOptionSet GHCiOption
opt
 = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return (GHCiOption
opt GHCiOption -> [GHCiOption] -> 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 :: 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 :: [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 :: GhciMonad m => GHCiOption -> m ()
unsetOption :: 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 :: [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 SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> m ()
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 -> 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 ModuleInfo
info SDoc
doc = do
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  Maybe PrintUnqualified
mUnqual <- ModuleInfo -> m (Maybe PrintUnqualified)
forall (m :: Type -> Type).
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 :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual PrintUnqualified -> m PrintUnqualified
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe PrintUnqualified
mUnqual
  IO () -> m ()
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 -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUser DynFlags
dflags Handle
stdout PrintUnqualified
unqual SDoc
doc

printForUser :: GhcMonad m => SDoc -> m ()
printForUser :: SDoc -> m ()
printForUser SDoc
doc = do
  PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> m ()
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 -> PrintUnqualified -> SDoc -> IO ()
Outputable.printForUser DynFlags
dflags Handle
stdout PrintUnqualified
unqual SDoc
doc

printForUserPartWay :: GhcMonad m => SDoc -> m ()
printForUserPartWay :: SDoc -> m ()
printForUserPartWay SDoc
doc = do
  PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
  DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  IO () -> m ()
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 -> 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
  :: GhciMonad m
  => GhciLStmt GhcPs -> String -> GHC.SingleStep -> m (Maybe GHC.ExecResult)
runStmt :: 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.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\SourceError
e -> do SourceError -> m ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e; Maybe ExecResult -> m (Maybe ExecResult)
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
                  { 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 = \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 :: 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 (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.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError (\SourceError
e -> do SourceError -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e;
                                        Maybe [Name] -> GHCi (Maybe [Name])
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 (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' :: [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 (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.
ExceptionMonad m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError
        (\SourceError
e -> do SourceError -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e;
                  Maybe [Name] -> GHCi (Maybe [Name])
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 -> m GHC.ExecResult
resume :: (SrcSpan -> Bool) -> SingleStep -> m ExecResult
resume SrcSpan -> Bool
canLogSpan SingleStep
step = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  ((Session, IORef GHCiState) -> IO ExecResult) -> m ExecResult
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 -> GHCi ExecResult
forall (m :: Type -> Type).
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
  :: GhciMonad m
  => (a -> Maybe Integer)
  -> m a
  -> m (ActionStats, Either SomeException a)
runAndPrintStats :: (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 (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 (m :: Type -> Type) a. Monad m => a -> m a
return ()
  (ActionStats, Either SomeException a)
-> m (ActionStats, Either SomeException 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 :: (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 (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.
(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 :: 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 (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
showSDoc DynFlags
dflags (
                 SDoc -> SDoc
parens (String -> SDoc
text (ShowS
secs_str String
"") SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"secs" SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
                         case Maybe Integer
mallocs of
                           Maybe Integer
Nothing -> SDoc
empty
                           Just Integer
allocs ->
                             String -> SDoc
text (Integer -> String
forall a. Show a => a -> String
separateThousands Integer
allocs) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"bytes")))
  where
    separateThousands :: a -> String
separateThousands 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 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
sep (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3 String
n')

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

revertCAFs :: GhciMonad m => m ()
revertCAFs :: m ()
revertCAFs = do
  HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
  IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> Message () -> IO ()
forall a. Binary a => HscEnv -> Message a -> IO a
iservCmd HscEnv
hsc_env 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 (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 String
"disableBuffering"
  ForeignHValue
flush <- OccName -> Ghc ForeignHValue
mkHelperExpr (OccName -> Ghc ForeignHValue) -> OccName -> Ghc ForeignHValue
forall a b. (a -> b) -> a -> b
$ String -> OccName
mkVarOcc String
"flushAll"
  (ForeignHValue, ForeignHValue)
-> Ghc (ForeignHValue, ForeignHValue)
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 :: m ()
flushInterpBuffers = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
  IO () -> m ()
forall (m :: Type -> Type) 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 (GHCiState -> ForeignHValue
flushStdHandles GHCiState
st)

-- | Turn off buffering for stdin, stdout, and stderr in the interpreter
turnOffBuffering :: GhciMonad m => m ()
turnOffBuffering :: 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_ :: ForeignHValue -> m ()
turnOffBuffering_ ForeignHValue
fhv = do
  HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
getSession
  IO () -> m ()
forall (m :: Type -> Type) 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 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
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 String
"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 :: Type -> Type) a.
GhcMonad m =>
(HscEnv -> HscEnv) -> m a -> m a
withTempSession HscEnv -> HscEnv
mkTempSession
  where
    mkTempSession :: HscEnv -> HscEnv
mkTempSession HscEnv
hsc_env = HscEnv
hsc_env
      { hsc_dflags :: DynFlags
hsc_dflags = (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) {
        -- Running GHCi's internal expression is incompatible with -XSafe.
          -- We temporarily disable any Safe Haskell settings while running
          -- GHCi internal expressions. (see #12509)
        safeHaskell :: SafeHaskellMode
safeHaskell = SafeHaskellMode
Sf_None
      }
        -- 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 :: 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