{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
--
-- GHC Interactive User Interface
--
-- (c) The GHC Team 2005-2006
--
-----------------------------------------------------------------------------

module Clash.GHCi.UI (
        interactiveUI,
        GhciSettings(..),
        defaultGhciSettings,
        ghciCommands,
        ghciWelcomeMsg,
        makeHDL
    ) where

#include "HsVersions.h"

-- GHCi
import qualified Clash.GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
import Clash.GHCi.UI.Monad hiding ( args, runStmt )
import Clash.GHCi.UI.Tags
import Clash.GHCi.UI.Info
import GHC.Runtime.Debugger

-- The GHC interface
import GHC.Runtime.Interpreter
import GHC.Runtime.Interpreter.Types
import GHCi.RemoteTypes
import GHCi.BreakArray
import GHC.Driver.Session as DynFlags
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Finder as Finder
import GHC.Driver.Monad ( modifySession )
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
             TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
             GetDocsFailure(..),
             getModuleGraph, handleSourceError, ms_mod )
import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
import GHC.Driver.Types ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
                  setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc,
                  hsc_dynLinker, hsc_interp, emptyModBreaks )
import GHC.Unit.Module
import GHC.Types.Name
import GHC.Unit.State   ( unitIsTrusted, unsafeLookupUnit, unsafeLookupUnitId,
                          listVisibleModuleNames, pprFlag, preloadUnits )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Core.Ppr.TyThing
import GHC.Builtin.Names
import GHC.Builtin.Types( stringTyCon_RDR )
import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
import GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Parser.Lexer as Lexer

import GHC.Data.StringBuffer
import GHC.Utils.Outputable hiding ( printForUser )

import GHC.Runtime.Loader ( initializePlugins )

-- Other random utilities
import GHC.Types.Basic hiding ( isTopLevel )
import GHC.Data.Graph.Directed
import GHC.Utils.Encoding
import GHC.Data.FastString
import GHC.Runtime.Linker
import GHC.Data.Maybe ( orElse, expectJust )
import GHC.Types.Name.Set
import GHC.Utils.Panic hiding ( showException, try )
import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Bag (unitBag)

-- Haskell Libraries
import System.Console.Haskeline as Haskeline

import Control.Applicative hiding (empty)
import Control.DeepSeq (deepseq)
import Control.Monad as Monad
import Control.Monad.Catch as MC
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except

import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Function
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( elemIndices, find, group, intercalate, intersperse,
                   isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import Data.Proxy
import qualified Data.Set as S
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.IntMap.Strict as IntMap
import Data.Time.LocalTime ( getZonedTime )
import Data.Time.Format ( formatTime, defaultTimeLocale )
import Data.Version ( showVersion )
import Prelude hiding ((<>))

import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
import Foreign hiding (void)
import GHC.Stack hiding (SrcLoc(..))

import System.Directory
import System.Environment
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.Info
import System.IO
import System.IO.Error
import System.IO.Unsafe ( unsafePerformIO )
import System.Process
import Text.Printf
import Text.Read ( readMaybe )
import Text.Read.Lex (isSymbolChar)

import Unsafe.Coerce

#if !defined(mingw32_HOST_OS)
import System.Posix hiding ( getEnv )
#else
import qualified System.Win32
#endif

import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import GHC.IO.Handle ( hFlushAll )
import GHC.TopHandler ( topHandler )

import Clash.GHCi.Leak

-- clash additions
import           Clash.Backend (Backend(initBackend, hdlKind, primDirs))
import           Clash.Backend.SystemVerilog (SystemVerilogState)
import           Clash.Backend.VHDL (VHDLState)
import           Clash.Backend.Verilog (VerilogState)
import qualified Clash.Driver
import           Clash.Driver.Types (ClashOpts(..), ClashEnv(..), ClashDesign(..))
import           Clash.GHC.Evaluator
import           Clash.GHC.GenerateBindings
import           Clash.GHC.NetlistTypes
import           Clash.GHC.PartialEval
import           Clash.GHCi.Common
import           Clash.Util (clashLibVersion, reportTimeDiff)
import qualified Data.Time.Clock as Clock
import qualified Paths_clash_ghc

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

data GhciSettings = GhciSettings {
        GhciSettings -> [Command]
availableCommands :: [Command],
        GhciSettings -> [Char]
shortHelpText     :: String,
        GhciSettings -> [Char]
fullHelpText      :: String,
        GhciSettings -> PromptFunction
defPrompt         :: PromptFunction,
        GhciSettings -> PromptFunction
defPromptCont     :: PromptFunction
    }

defaultGhciSettings :: IORef ClashOpts -> GhciSettings
defaultGhciSettings :: IORef ClashOpts -> GhciSettings
defaultGhciSettings IORef ClashOpts
opts =
    GhciSettings :: [Command]
-> [Char]
-> [Char]
-> PromptFunction
-> PromptFunction
-> GhciSettings
GhciSettings {
        availableCommands :: [Command]
availableCommands = IORef ClashOpts -> [Command]
ghciCommands IORef ClashOpts
opts,
        shortHelpText :: [Char]
shortHelpText     = [Char]
defShortHelpText,
        defPrompt :: PromptFunction
defPrompt         = PromptFunction
default_prompt,
        defPromptCont :: PromptFunction
defPromptCont     = PromptFunction
default_prompt_cont,
        fullHelpText :: [Char]
fullHelpText      = [Char]
defFullHelpText
    }

ghciWelcomeMsg :: String
ghciWelcomeMsg :: [Char]
ghciWelcomeMsg = [Char]
"Clashi, version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
Data.Version.showVersion Version
Paths_clash_ghc.version [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
" (using clash-lib, version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
Data.Version.showVersion Version
clashLibVersion [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
"):\nhttps://clash-lang.org/  :? for help"

ghciCommands :: IORef ClashOpts -> [Command]
ghciCommands :: IORef ClashOpts -> [Command]
ghciCommands IORef ClashOpts
opts = (([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
 -> Command)
-> [([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)]
-> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
-> Command
mkCmd [
  -- Hugs users are accustomed to :e, so make sure it doesn't overlap
  ([Char]
"?",         ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help,                 CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"add",       ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
addModule,       CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"abandon",   ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
abandonCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"break",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
breakCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeBreakpoint),
  ([Char]
"back",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
backCmd,              CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"browse",    ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
browseCmd Bool
False),   CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
  ([Char]
"browse!",   ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
browseCmd Bool
True),    CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
  ([Char]
"cd",        ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory,     CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"check",     ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
checkModule,         CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModule),
  ([Char]
"continue",  ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
continueCmd,          CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"cmd",       ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
cmdCmd,               CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"ctags",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createCTagsWithLineNumbersCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"ctags!",    ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createCTagsWithRegExesCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"def",       ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing (Bool -> [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
defineMacro Bool
False),  CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"def!",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing (Bool -> [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
defineMacro Bool
True),   CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"delete",    ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
deleteCmd,            CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"disable",   ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
disableCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"doc",       ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
docCmd,              CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"edit",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
editFile,            CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"enable",    ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
enableCmd,            CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"etags",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createETagsFileCmd,   CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"force",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
forceCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"forward",   ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
forwardCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"help",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help,                 CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"history",   ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
historyCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"info",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
False),        CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"info!",     ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
True),         CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"issafe",    ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
isSafeCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
  ([Char]
"kind",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
kindOfType Bool
False),  CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"kind!",     ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
kindOfType Bool
True),   CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"load",      ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModule_,     CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
  ([Char]
"load!",     ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModuleDefer, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
  ([Char]
"list",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
listCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"module",    ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
moduleCmd,            CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetModule),
  ([Char]
"main",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runMain,              CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"print",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
printCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"quit",      [Char] -> InputT GHCi Bool
forall (m :: Type -> Type). Monad m => [Char] -> m Bool
quit,                           CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"reload",    ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule,        CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"reload!",   ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModuleDefer,   CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"run",       ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runRun,               CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"script",    ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
scriptCmd,           CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"set",       ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setCmd,               CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetOptions),
  ([Char]
"seti",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setiCmd,              CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSeti),
  ([Char]
"show",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
showCmd,              CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowOptions),
  ([Char]
"showi",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
showiCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowiOptions),
  ([Char]
"sprint",    ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
sprintCmd,            CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"step",      ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd,              CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"steplocal", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepLocalCmd,         CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"stepmodule",([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepModuleCmd,        CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
  ([Char]
"type",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
typeOfExpr,          CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"trace",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
traceCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
  ([Char]
"unadd",     ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
unAddModule,     CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
  ([Char]
"undef",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
undefineMacro,        CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeMacro),
  ([Char]
"unset",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
unsetOptions,         CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetOptions),
  ([Char]
"where",     ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
whereCmd,             CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
  ([Char]
"vhdl",      ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVHDL IORef ClashOpts
opts),        CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
  ([Char]
"verilog",   ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVerilog IORef ClashOpts
opts),     CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
  ([Char]
"systemverilog",   ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeSystemVerilog IORef ClashOpts
opts),     CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
  ([Char]
"instances", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
instancesCmd,        CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression)
  ] [Command] -> [Command] -> [Command]
forall a. [a] -> [a] -> [a]
++ (([Char], [Char] -> InputT GHCi Bool) -> Command)
-> [([Char], [Char] -> InputT GHCi Bool)] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi Bool) -> Command
mkCmdHidden [ -- hidden commands
  ([Char]
"all-types", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
allTypesCmd),
  ([Char]
"complete",  ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
completeCmd),
  ([Char]
"loc-at",    ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
locAtCmd),
  ([Char]
"type-at",   ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeAtCmd),
  ([Char]
"uses",      ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
usesCmd)
  ]
 where
  mkCmd :: ([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
-> Command
mkCmd ([Char]
n,[Char] -> InputT GHCi Bool
a,CompletionFunc GHCi
c) = Command :: [Char]
-> ([Char] -> InputT GHCi Bool)
-> Bool
-> CompletionFunc GHCi
-> Command
Command { cmdName :: [Char]
cmdName = [Char]
n
                          , cmdAction :: [Char] -> InputT GHCi Bool
cmdAction = [Char] -> InputT GHCi Bool
a
                          , cmdHidden :: Bool
cmdHidden = Bool
False
                          , cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
c
                          }

  mkCmdHidden :: ([Char], [Char] -> InputT GHCi Bool) -> Command
mkCmdHidden ([Char]
n,[Char] -> InputT GHCi Bool
a) = Command :: [Char]
-> ([Char] -> InputT GHCi Bool)
-> Bool
-> CompletionFunc GHCi
-> Command
Command { cmdName :: [Char]
cmdName = [Char]
n
                              , cmdAction :: [Char] -> InputT GHCi Bool
cmdAction = [Char] -> InputT GHCi Bool
a
                              , cmdHidden :: Bool
cmdHidden = Bool
True
                              , cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion
                              }

-- We initialize readline (in the interactiveUI function) to use
-- word_break_chars as the default set of completion word break characters.
-- This can be overridden for a particular command (for example, filename
-- expansion shouldn't consider '/' to be a word break) by setting the third
-- entry in the Command tuple above.
--
-- NOTE: in order for us to override the default correctly, any custom entry
-- must be a SUBSET of word_break_chars.
word_break_chars :: String
word_break_chars :: [Char]
word_break_chars = [Char]
spaces [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specials [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
symbols

symbols, specials, spaces :: String
symbols :: [Char]
symbols = [Char]
"!#$%&*+/<=>?@\\^|-~"
specials :: [Char]
specials = [Char]
"(),;[]`{}"
spaces :: [Char]
spaces = [Char]
" \t\n"

flagWordBreakChars :: String
flagWordBreakChars :: [Char]
flagWordBreakChars = [Char]
" \t\n"


keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
keepGoing :: ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
a [Char]
str = ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (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 ())
-> ([Char] -> GHCi ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GHCi ()
a) [Char]
str

keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
keepGoing' :: forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> m ()
a [Char]
str = [Char] -> m ()
a [Char]
str m () -> m Bool -> m Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False

keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
keepGoingPaths :: ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
a [Char]
str
 = do case [Char] -> Either [Char] [[Char]]
toArgs [Char]
str of
          Left [Char]
err -> IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
          Right [[Char]]
args -> [[Char]] -> InputT GHCi ()
a [[Char]]
args
      Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False

defShortHelpText :: String
defShortHelpText :: [Char]
defShortHelpText = [Char]
"use :? for help.\n"

defFullHelpText :: String
defFullHelpText :: [Char]
defFullHelpText =
  [Char]
" Commands available from the prompt:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   <statement>                 evaluate/run <statement>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :                           repeat last command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :{\\n ..lines.. \\n:}\\n       multiline command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :add [*]<module> ...        add module(s) to the current target set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :browse[!] [[*]<mod>]       display the names defined by module <mod>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: more details; *: all top-level names)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :cd <dir>                   change directory to <dir>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :cmd <expr>                 run the commands returned by <expr>::IO String\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :complete <dom> [<rng>] <s> list completions for partial input string\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :ctags[!] [<file>]          create tags file <file> for Vi (default: \"tags\")\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: use regex instead of line number)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :def[!] <cmd> <expr>        define command :<cmd> (later defined command has\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               precedence, ::<cmd> is always a builtin command)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: redefine an existing command name)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :doc <name>                 display docs for the given name (experimental)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :edit <file>                edit file\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :edit                       edit last module\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :etags [<file>]             create tags file <file> for Emacs (default: \"TAGS\")\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :help, :?                   display this list of commands\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :info[!] [<name> ...]       display information about the given names\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: do not filter instances)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :instances <type>           display the class instances available for <type>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :issafe [<mod>]             display safe haskell information of module <mod>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :kind[!] <type>             show the kind of <type>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: also print the normalised type)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :load[!] [*]<module> ...    load module(s) and their dependents\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: defer type errors)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :main [<arguments> ...]     run the main function with the given arguments\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :quit                       exit GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :reload[!]                  reload the current module set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (!: defer type errors)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :run function [<arguments> ...] run the function with the given arguments\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :script <file>              run the script <file>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :type <expr>                show the type of <expr>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :type +d <expr>             show the type of <expr>, defaulting type variables\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :type +v <expr>             show the type of <expr>, with its specified tyvars\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :unadd <module> ...         remove module(s) from the current target set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :undef <cmd>                undefine user-defined command :<cmd>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   ::<cmd>                     run the builtin command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :!<command>                 run the shell command <command>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :vhdl                       synthesize currently loaded module to vhdl\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :vhdl [<module>]            synthesize specified modules/files to vhdl\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :verilog                    synthesize currently loaded module to verilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :verilog [<module>]         synthesize specified modules/files to verilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :systemverilog              synthesize currently loaded module to systemverilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :systemverilog [<module>]   synthesize specified modules/files to systemverilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
" -- Commands for debugging:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :abandon                    at a breakpoint, abandon current computation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :back [<n>]                 go back in the history N steps (after :trace)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :break [<mod>] <l> [<col>]  set a breakpoint at the specified location\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :break <name>               set a breakpoint on the specified function\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :continue                   resume after a breakpoint\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :delete <number> ...        delete the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :delete *                   delete all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :disable <number> ...       disable the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :disable *                  disable all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :enable <number> ...        enable the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :enable *                   enable all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :force <expr>               print <expr>, forcing unevaluated parts\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :forward [<n>]              go forward in the history N step s(after :back)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :history [<n>]              after :trace, show the execution history\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :list                       show the source code around current breakpoint\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :list <identifier>          show the source code for <identifier>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :list [<module>] <line>     show the source code around line number <line>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :print [<name> ...]         show a value without forcing its computation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :sprint [<name> ...]        simplified version of :print\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :step                       single-step after stopping at a breakpoint\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :step <expr>                single-step into <expr>\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :steplocal                  single-step within the current top-level binding\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :stepmodule                 single-step restricted to the current module\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :trace                      trace after stopping at a breakpoint\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :trace <expr>               evaluate <expr> with tracing on (see :history)\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++

  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
" -- Commands for changing settings:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set <option> ...           set options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :seti <option> ...          set options for interactive evaluation only\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set local-config { source | ignore }\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               set whether to source .ghci in current dir\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               (loading untrusted config is a security issue)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set args <arg> ...         set the arguments returned by System.getArgs\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set prog <progname>        set the value returned by System.getProgName\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set prompt <prompt>        set the prompt used in GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set prompt-cont <prompt>   set the continuation prompt used in GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set prompt-function <expr> set the function to handle the prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set prompt-cont-function <expr>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                               set the function to handle the continuation prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set editor <cmd>           set the command used for :edit\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :unset <option> ...         unset options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"  Options for ':set' and ':unset':\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    +m            allow multiline commands\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    +r            revert top-level expressions after each evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    +s            print timing/memory stats after each evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    +t            print type after evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    +c            collect type/location info after loading modules\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"    -<flags>      most GHC command line flags can also be set here\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                         (eg. -v2, -XFlexibleInstances, etc.)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                    for GHCi-specific flags, see User's Guide,\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                    Flag reference, Interactive-mode options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
" -- Commands for displaying information:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show bindings              show the current bindings made at the prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show breaks                show the active breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show context               show the breakpoint context\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show imports               show the current imports\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show linker                show current linker state\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show modules               show the currently loaded modules\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show packages              show the currently active package flags\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show paths                 show the currently active search paths\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show language              show the currently active language flags\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show targets               show the current set of targets\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :show <setting>             show value of <setting>, which is one of\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"                                  [args, prog, editor, stop]\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   :showi language             show language flags for interactive evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
" The User's Guide has more information. An online copy can be found here:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"   https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
"\n"

findEditor :: IO String
findEditor :: IO [Char]
findEditor = do
  [Char] -> IO [Char]
getEnv [Char]
"EDITOR"
    IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
#if defined(mingw32_HOST_OS)
        win <- System.Win32.getWindowsDirectory
        return (win </> "notepad.exe")
#else
        [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
#endif

default_progname, default_stop :: String
default_progname :: [Char]
default_progname = [Char]
"<interactive>"
default_stop :: [Char]
default_stop = [Char]
""

default_prompt, default_prompt_cont :: PromptFunction
default_prompt :: PromptFunction
default_prompt = [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
"clashi> "
default_prompt_cont :: PromptFunction
default_prompt_cont = [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
"| "

default_args :: [String]
default_args :: [[Char]]
default_args = []

interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
              -> Ghc ()
interactiveUI :: GhciSettings -> [([Char], Maybe Phase)] -> Maybe [[Char]] -> Ghc ()
interactiveUI GhciSettings
config [([Char], Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs = do
   -- HACK! If we happen to get into an infinite loop (eg the user
   -- types 'let x=x in x' at the prompt), then the thread will block
   -- on a blackhole, and become unreachable during GC.  The GC will
   -- detect that it is unreachable and send it the NonTermination
   -- exception.  However, since the thread is unreachable, everything
   -- it refers to might be finalized, including the standard Handles.
   -- This sounds like a bug, but we don't have a good solution right
   -- now.
   StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stdin
   StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stdout
   StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stderr

    -- Initialise buffering for the *interpreted* I/O system
   (ForeignHValue
nobuffering, ForeignHValue
flush) <- Ghc (ForeignHValue, ForeignHValue)
initInterpBuffering

   -- The initial set of DynFlags used for interactive evaluation is the same
   -- as the global DynFlags, plus -XExtendedDefaultRules and
   -- -XNoMonomorphismRestriction.
   -- See note [Changing language extensions for interactive evaluation] #10857
   DynFlags
dflags <- Ghc DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
   let dflags' :: DynFlags
dflags' = (Extension
-> (DynFlags -> Extension -> DynFlags) -> DynFlags -> DynFlags
xopt_set_unlessExplSpec
                      Extension
LangExt.ExtendedDefaultRules DynFlags -> Extension -> DynFlags
xopt_set)
               (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension
-> (DynFlags -> Extension -> DynFlags) -> DynFlags -> DynFlags
xopt_set_unlessExplSpec
                      Extension
LangExt.MonomorphismRestriction DynFlags -> Extension -> DynFlags
xopt_unset)
               (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
dflags
   DynFlags -> Ghc ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setInteractiveDynFlags DynFlags
dflags'

   IORef [(FastString, Int)]
lastErrLocationsRef <- IO (IORef [(FastString, Int)]) -> Ghc (IORef [(FastString, Int)])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [(FastString, Int)]) -> Ghc (IORef [(FastString, Int)]))
-> IO (IORef [(FastString, Int)])
-> Ghc (IORef [(FastString, Int)])
forall a b. (a -> b) -> a -> b
$ [(FastString, Int)] -> IO (IORef [(FastString, Int)])
forall a. a -> IO (IORef a)
newIORef []
   DynFlags
progDynFlags <- Ghc DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getProgramDynFlags
   Bool
_ <- DynFlags -> Ghc Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags (DynFlags -> Ghc Bool) -> DynFlags -> Ghc Bool
forall a b. (a -> b) -> a -> b
$
      -- Ensure we don't override the user's log action lest we break
      -- -ddump-json (#14078)
      DynFlags
progDynFlags { log_action :: LogAction
log_action = LogAction -> IORef [(FastString, Int)] -> LogAction
ghciLogAction (DynFlags -> LogAction
log_action DynFlags
progDynFlags)
                                                IORef [(FastString, Int)]
lastErrLocationsRef }

   Bool -> Ghc () -> Ghc ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [[Char]]
maybe_exprs) (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ do
        -- Only for GHCi (not runghc and ghc -e):

        -- Turn buffering off for the compiled program's stdout/stderr
        ForeignHValue -> Ghc ()
forall (m :: Type -> Type). GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ ForeignHValue
nobuffering
        -- Turn buffering off for GHCi's stdout
        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
$ Handle -> IO ()
hFlush Handle
stdout
        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
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.
        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
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
        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
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
#if defined(mingw32_HOST_OS)
        -- On Unix, stdin will use the locale encoding.  The IO library
        -- doesn't do this on Windows (yet), so for now we use UTF-8,
        -- for consistency with GHC 6.10 and to make the tests work.
        liftIO $ hSetEncoding stdin utf8
#endif

   [Char]
default_editor <- IO [Char] -> Ghc [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> Ghc [Char]) -> IO [Char] -> Ghc [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
findEditor
   ForeignHValue
eval_wrapper <- [Char] -> [[Char]] -> Ghc ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper [Char]
default_progname [[Char]]
default_args
   let prelude_import :: ImportDecl (GhcPass p)
prelude_import = ModuleName -> ImportDecl (GhcPass p)
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl ModuleName
preludeModuleName
   GHCi () -> GHCiState -> Ghc ()
forall a. GHCi a -> GHCiState -> Ghc a
startGHCi ([([Char], Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs)
        GHCiState :: [Char]
-> [[Char]]
-> ForeignHValue
-> PromptFunction
-> PromptFunction
-> [Char]
-> [Char]
-> LocalConfigBehaviour
-> [GHCiOption]
-> Int
-> Int
-> IntMap BreakLocation
-> ModuleEnv TickArray
-> [Command]
-> [Command]
-> Maybe Command
-> (InputT GHCi CommandResult -> InputT GHCi (Maybe Bool))
-> [[Char]]
-> [InteractiveImport]
-> [InteractiveImport]
-> [ImportDecl GhcPs]
-> [ImportDecl GhcPs]
-> Bool
-> [Char]
-> [Char]
-> IORef [(FastString, Int)]
-> Map ModuleName ModInfo
-> ForeignHValue
-> ForeignHValue
-> GHCiState
GHCiState{ progname :: [Char]
progname           = [Char]
default_progname,
                   args :: [[Char]]
args               = [[Char]]
default_args,
                   evalWrapper :: ForeignHValue
evalWrapper        = ForeignHValue
eval_wrapper,
                   prompt :: PromptFunction
prompt             = GhciSettings -> PromptFunction
defPrompt GhciSettings
config,
                   prompt_cont :: PromptFunction
prompt_cont        = GhciSettings -> PromptFunction
defPromptCont GhciSettings
config,
                   stop :: [Char]
stop               = [Char]
default_stop,
                   editor :: [Char]
editor             = [Char]
default_editor,
                   options :: [GHCiOption]
options            = [],
                   localConfig :: LocalConfigBehaviour
localConfig        = LocalConfigBehaviour
SourceLocalConfig,
                   -- We initialize line number as 0, not 1, because we use
                   -- current line number while reporting errors which is
                   -- incremented after reading a line.
                   line_number :: Int
line_number        = Int
0,
                   break_ctr :: Int
break_ctr          = Int
0,
                   breaks :: IntMap BreakLocation
breaks             = IntMap BreakLocation
forall a. IntMap a
IntMap.empty,
                   tickarrays :: ModuleEnv TickArray
tickarrays         = ModuleEnv TickArray
forall a. ModuleEnv a
emptyModuleEnv,
                   ghci_commands :: [Command]
ghci_commands      = GhciSettings -> [Command]
availableCommands GhciSettings
config,
                   ghci_macros :: [Command]
ghci_macros        = [],
                   last_command :: Maybe Command
last_command       = Maybe Command
forall a. Maybe a
Nothing,
                   cmd_wrapper :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
cmd_wrapper        = (CommandResult -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type).
MonadThrow m =>
CommandResult -> m (Maybe Bool)
cmdSuccess (CommandResult -> InputT GHCi (Maybe Bool))
-> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<),
                   cmdqueue :: [[Char]]
cmdqueue           = [],
                   remembered_ctx :: [InteractiveImport]
remembered_ctx     = [],
                   transient_ctx :: [InteractiveImport]
transient_ctx      = [],
                   extra_imports :: [ImportDecl GhcPs]
extra_imports      = [],
                   prelude_imports :: [ImportDecl GhcPs]
prelude_imports    = [ImportDecl GhcPs
forall {p :: Pass}. ImportDecl (GhcPass p)
prelude_import],
                   ghc_e :: Bool
ghc_e              = Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs,
                   short_help :: [Char]
short_help         = GhciSettings -> [Char]
shortHelpText GhciSettings
config,
                   long_help :: [Char]
long_help          = GhciSettings -> [Char]
fullHelpText GhciSettings
config,
                   lastErrorLocations :: IORef [(FastString, Int)]
lastErrorLocations = IORef [(FastString, Int)]
lastErrLocationsRef,
                   mod_infos :: Map ModuleName ModInfo
mod_infos          = Map ModuleName ModInfo
forall k a. Map k a
M.empty,
                   flushStdHandles :: ForeignHValue
flushStdHandles    = ForeignHValue
flush,
                   noBuffering :: ForeignHValue
noBuffering        = ForeignHValue
nobuffering
                 }

   () -> Ghc ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

{-
Note [Changing language extensions for interactive evaluation]
--------------------------------------------------------------
GHCi maintains two sets of options:

- The "loading options" apply when loading modules
- The "interactive options" apply when evaluating expressions and commands
    typed at the GHCi prompt.

The loading options are mostly created in ghc/Main.hs:main' from the command
line flags. In the function ghc/GHCi/UI.hs:interactiveUI the loading options
are copied to the interactive options.

These interactive options (but not the loading options!) are supplemented
unconditionally by setting ExtendedDefaultRules ON and
MonomorphismRestriction OFF. The unconditional setting of these options
eventually overwrite settings already specified at the command line.

Therefore instead of unconditionally setting ExtendedDefaultRules and
NoMonomorphismRestriction for the interactive options, we use the function
'xopt_set_unlessExplSpec' to first check whether the extension has already
specified at the command line.

The ghci config file has not yet been processed.
-}

resetLastErrorLocations :: GhciMonad m => m ()
resetLastErrorLocations :: forall (m :: Type -> Type). GhciMonad m => m ()
resetLastErrorLocations = do
    GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
    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
$ IORef [(FastString, Int)] -> [(FastString, Int)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GHCiState -> IORef [(FastString, Int)]
lastErrorLocations GHCiState
st) []

ghciLogAction :: LogAction -> IORef [(FastString, Int)] ->  LogAction
ghciLogAction :: LogAction -> IORef [(FastString, Int)] -> LogAction
ghciLogAction LogAction
old_log_action IORef [(FastString, Int)]
lastErrLocations
              DynFlags
dflags WarnReason
flag Severity
severity SrcSpan
srcSpan SDoc
msg = do
    LogAction
old_log_action DynFlags
dflags WarnReason
flag Severity
severity SrcSpan
srcSpan SDoc
msg
    case Severity
severity of
        Severity
SevError -> case SrcSpan
srcSpan of
            RealSrcSpan RealSrcSpan
rsp Maybe BufSpan
_ -> IORef [(FastString, Int)]
-> ([(FastString, Int)] -> [(FastString, Int)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(FastString, Int)]
lastErrLocations
                ([(FastString, Int)] -> [(FastString, Int)] -> [(FastString, Int)]
forall a. [a] -> [a] -> [a]
++ [(RealSrcLoc -> FastString
srcLocFile (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
rsp), RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
rsp))])
            SrcSpan
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
        Severity
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
withGhcAppData :: forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData [Char] -> IO a
right IO a
left = do
    Either IOException [Char]
either_dir <- IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IO [Char]
getAppUserDataDirectory [Char]
"clash")
    case Either IOException [Char]
either_dir of
        Right [Char]
dir ->
            do Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
dir IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
               [Char] -> IO a
right [Char]
dir
        Either IOException [Char]
_ -> IO a
left

runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi :: [([Char], Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe Phase)]
paths Maybe [[Char]]
maybe_exprs = do
  DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  let
   ignore_dot_ghci :: Bool
ignore_dot_ghci = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_IgnoreDotGhci DynFlags
dflags

   app_user_dir :: GHCi (Maybe [Char])
app_user_dir = IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData
                    (\[Char]
dir -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"clashi.conf")))
                    (Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)

   home_dir :: GHCi (Maybe [Char])
home_dir = do
    Either IOException [Char]
either_dir <- IO (Either IOException [Char]) -> GHCi (Either IOException [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char])
 -> GHCi (Either IOException [Char]))
-> IO (Either IOException [Char])
-> GHCi (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IO [Char]
getEnv [Char]
"HOME")
    case Either IOException [Char]
either_dir of
      Right [Char]
home -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
home [Char] -> [Char] -> [Char]
</> [Char]
".clashi"))
      Either IOException [Char]
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing

   canonicalizePath' :: FilePath -> IO (Maybe FilePath)
   canonicalizePath' :: [Char] -> IO (Maybe [Char])
canonicalizePath' [Char]
fp = ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> IO [Char]
canonicalizePath [Char]
fp)
                IO (Maybe [Char])
-> (IOException -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing

   sourceConfigFile :: FilePath -> GHCi ()
   sourceConfigFile :: [Char] -> GHCi ()
sourceConfigFile [Char]
file = do
     Bool
exists <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> GHCi Bool) -> IO Bool -> GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
file
     Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
exists (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
       Either IOException Handle
either_hdl <- IO (Either IOException Handle) -> GHCi (Either IOException Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Handle)
 -> GHCi (Either IOException Handle))
-> IO (Either IOException Handle)
-> GHCi (Either IOException Handle)
forall a b. (a -> b) -> a -> b
$ IO Handle -> IO (Either IOException Handle)
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IOMode -> IO Handle
openFile [Char]
file IOMode
ReadMode)
       case Either IOException Handle
either_hdl of
         Left IOException
_e   -> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
         -- NOTE: this assumes that runInputT won't affect the terminal;
         -- can we assume this will always be the case?
         -- This would be a good place for runFileInputT.
         Right Handle
hdl ->
             do Prefs -> Settings GHCi -> InputT GHCi () -> GHCi ()
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi () -> GHCi ()) -> InputT GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
                          InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands (InputT GHCi (Maybe [Char]) -> InputT GHCi ())
-> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
hdl
                IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
hdl IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
                -- Don't print a message if this is really ghc -e (#11478).
                -- Also, let the user silence the message with -v0
                -- (the default verbosity in GHCi is 1).
                Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [[Char]]
maybe_exprs Bool -> Bool -> Bool
&& DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
                  IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char]
"Loaded Clashi configuration from " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)

  --

  GHCi ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState

  [[Char]]
processedCfgs <- if Bool
ignore_dot_ghci
    then [[Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
    else do
      [[Char]]
userCfgs <- do
        [[Char]]
paths <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]])
-> GHCi [Maybe [Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCi (Maybe [Char])] -> GHCi [Maybe [Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ GHCi (Maybe [Char])
app_user_dir, GHCi (Maybe [Char])
home_dir ]
        [[Char]]
checkedPaths <- IO [[Char]] -> GHCi [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> GHCi [[Char]]) -> IO [[Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
checkFileAndDirPerms [[Char]]
paths
        IO [[Char]] -> GHCi [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> GHCi [[Char]])
-> (IO [Maybe [Char]] -> IO [[Char]])
-> IO [Maybe [Char]]
-> GHCi [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([Maybe [Char]] -> [[Char]]) -> [Maybe [Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes) (IO [Maybe [Char]] -> GHCi [[Char]])
-> IO [Maybe [Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe [Char])
canonicalizePath' [[Char]]
checkedPaths

      Maybe [Char]
localCfg <- do
        let path :: [Char]
path = [Char]
".clashi"
        Bool
ok <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> GHCi Bool) -> IO Bool -> GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
checkFileAndDirPerms [Char]
path
        if Bool
ok then IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
canonicalizePath' [Char]
path else Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing

      ([Char] -> GHCi ()) -> [[Char]] -> GHCi ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> GHCi ()
sourceConfigFile [[Char]]
userCfgs
        -- Process the global and user .ghci
        -- (but not $CWD/.ghci or CLI args, yet)

      LocalConfigBehaviour
behaviour <- GHCiState -> LocalConfigBehaviour
localConfig (GHCiState -> LocalConfigBehaviour)
-> GHCi GHCiState -> GHCi LocalConfigBehaviour
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState

      Maybe [Char]
processedLocalCfg <- case Maybe [Char]
localCfg of
        Just [Char]
path | [Char]
path [Char] -> [[Char]] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` [[Char]]
userCfgs ->
          -- don't read .ghci twice if CWD is $HOME
          case LocalConfigBehaviour
behaviour of
            LocalConfigBehaviour
SourceLocalConfig -> Maybe [Char]
localCfg Maybe [Char] -> GHCi () -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ [Char] -> GHCi ()
sourceConfigFile [Char]
path
            LocalConfigBehaviour
IgnoreLocalConfig -> Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
        Maybe [Char]
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing

      [[Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> GHCi [[Char]]) -> [[Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]] -> [[Char]])
-> Maybe [Char]
-> [[Char]]
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[Char]] -> [[Char]]
forall a. a -> a
id (:) Maybe [Char]
processedLocalCfg [[Char]]
userCfgs

  let arg_cfgs :: [[Char]]
arg_cfgs = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ DynFlags -> [[Char]]
ghciScripts DynFlags
dflags
    -- -ghci-script are collected in reverse order
    -- We don't require that a script explicitly added by -ghci-script
    -- is owned by the current user. (#6017)

  ([Char] -> GHCi ()) -> [[Char]] -> GHCi ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> GHCi ()
sourceConfigFile ([[Char]] -> GHCi ()) -> [[Char]] -> GHCi ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub [[Char]]
arg_cfgs [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
processedCfgs
    -- Dedup, and remove any configs we already processed.
    -- Importantly, if $PWD/.ghci was ignored due to configuration,
    -- explicitly specifying it does cause it to be processed.

  -- Perform a :load for files given on the GHCi command line
  -- When in -e mode, if the load fails then we want to stop
  -- immediately rather than going on to evaluate the expression.
  Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([([Char], Maybe Phase)] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [([Char], Maybe Phase)]
paths)) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
     SuccessFlag
ok <- (SomeException -> GHCi SuccessFlag)
-> GHCi SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
e -> do SomeException -> GHCi ()
forall (m :: Type -> Type). MonadIO m => SomeException -> m ()
showException SomeException
e; SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Failed) (GHCi SuccessFlag -> GHCi SuccessFlag)
-> GHCi SuccessFlag -> GHCi SuccessFlag
forall a b. (a -> b) -> a -> b
$
                -- TODO: this is a hack.
                Prefs
-> Settings GHCi -> InputT GHCi SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi SuccessFlag -> GHCi SuccessFlag)
-> InputT GHCi SuccessFlag -> GHCi SuccessFlag
forall a b. (a -> b) -> a -> b
$
                    [([Char], Maybe Phase)] -> InputT GHCi SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule [([Char], Maybe Phase)]
paths
     Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs Bool -> Bool -> Bool
&& SuccessFlag -> Bool
failed SuccessFlag
ok) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
        IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1))

  Maybe [Char] -> Bool -> GHCi ()
forall (m :: Type -> Type).
GhcMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint (DynFlags -> Maybe [Char]
interactivePrint DynFlags
dflags) (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs)

  -- if verbosity is greater than 0, or we are connected to a
  -- terminal, display the prompt in the interactive loop.
  Bool
is_tty <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO Bool
hIsTerminalDevice Handle
stdin)
  let show_prompt :: Bool
show_prompt = DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Bool
is_tty

  -- reset line number
  (GHCiState -> GHCiState) -> GHCi ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState ((GHCiState -> GHCiState) -> GHCi ())
-> (GHCiState -> GHCiState) -> GHCi ()
forall a b. (a -> b) -> a -> b
$ \GHCiState
st -> GHCiState
st{line_number :: Int
line_number=Int
0}

  case Maybe [[Char]]
maybe_exprs of
        Maybe [[Char]]
Nothing ->
          do
            -- Set different defaulting rules (See #280)
            [[Char]] -> GHCi ()
runGHCiExpressions
              [[Char]
"default ((), [], Prelude.Integer, Prelude.Int, Prelude.Double, Prelude.String)"]

            -- enter the interactive loop
            InputT GHCi () -> GHCi ()
forall a. InputT GHCi a -> GHCi a
runGHCiInput (InputT GHCi () -> GHCi ()) -> InputT GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands (InputT GHCi (Maybe [Char]) -> InputT GHCi ())
-> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> InputT GHCi (Maybe [Char])
nextInputLine Bool
show_prompt Bool
is_tty
        Just [[Char]]
exprs -> do
            -- just evaluate the expression we were given
            [[Char]] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]]
exprs
            let hdle :: SomeException -> m b
hdle SomeException
e = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
                            -- flush the interpreter's stdout/stderr on exit (#3890)
                            m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
                            -- Jump through some hoops to get the
                            -- current progname in the exception text:
                            -- <progname>: <exception>
                            IO b -> m b
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ [Char] -> IO b -> IO b
forall a. [Char] -> IO a -> IO a
withProgName (GHCiState -> [Char]
progname GHCiState
st)
                                   (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ SomeException -> IO b
forall a. SomeException -> IO a
topHandler SomeException
e
                                   -- this used to be topHandlerFastExit, see #2228
            Prefs -> Settings GHCi -> InputT GHCi () -> GHCi ()
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi () -> GHCi ()) -> InputT GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
                -- make `ghc -e` exit nonzero on invalid input, see #7962
                ()
_ <- (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
forall {m :: Type -> Type} {b}. GhciMonad m => SomeException -> m b
hdle
                     (GHCi () -> Maybe (GHCi ())
forall a. a -> Maybe a
Just (GHCi () -> Maybe (GHCi ())) -> GHCi () -> Maybe (GHCi ())
forall a b. (a -> b) -> a -> b
$ SomeException -> GHCi Any
forall {m :: Type -> Type} {b}. GhciMonad m => SomeException -> m b
hdle (ExitCode -> SomeException
forall e. Exception e => e -> SomeException
toException (ExitCode -> SomeException) -> ExitCode -> SomeException
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1) GHCi Any -> GHCi () -> GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
                     (Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
                () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

  -- and finally, exit
  IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Leaving GHCi."

runGHCiExpressions :: [String] -> GHCi ()
runGHCiExpressions :: [[Char]] -> GHCi ()
runGHCiExpressions [[Char]]
exprs = do
    [[Char]] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]]
exprs
    let hdle :: SomeException -> m b
hdle SomeException
e = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
                    -- flush the interpreter's stdout/stderr on exit (#3890)
                    m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
                    -- Jump through some hoops to get the
                    -- current progname in the exception text:
                    -- <progname>: <exception>
                    IO b -> m b
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ [Char] -> IO b -> IO b
forall a. [Char] -> IO a -> IO a
withProgName (GHCiState -> [Char]
progname GHCiState
st)
                           (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ SomeException -> IO b
forall a. SomeException -> IO a
topHandler SomeException
e
                           -- this used to be topHandlerFastExit, see #2228
    Prefs -> Settings GHCi -> InputT GHCi () -> GHCi ()
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi () -> GHCi ()) -> InputT GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
        -- make `ghc -e` exit nonzero on invalid input, see #7962
        ()
_ <- (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
forall {m :: Type -> Type} {b}. GhciMonad m => SomeException -> m b
hdle
             (GHCi () -> Maybe (GHCi ())
forall a. a -> Maybe a
Just (GHCi () -> Maybe (GHCi ())) -> GHCi () -> Maybe (GHCi ())
forall a b. (a -> b) -> a -> b
$ SomeException -> GHCi Any
forall {m :: Type -> Type} {b}. GhciMonad m => SomeException -> m b
hdle (ExitCode -> SomeException
forall e. Exception e => e -> SomeException
toException (ExitCode -> SomeException) -> ExitCode -> SomeException
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1) GHCi Any -> GHCi () -> GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
             (Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
        () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

runGHCiInput :: InputT GHCi a -> GHCi a
runGHCiInput :: forall a. InputT GHCi a -> GHCi a
runGHCiInput InputT GHCi a
f = do
    DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
    let ghciHistory :: Bool
ghciHistory = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciHistory DynFlags
dflags
    let localGhciHistory :: Bool
localGhciHistory = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LocalGhciHistory DynFlags
dflags
    [Char]
currentDirectory <- IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getCurrentDirectory

    Maybe [Char]
histFile <- case (Bool
ghciHistory, Bool
localGhciHistory) of
      (Bool
True, Bool
True) -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
currentDirectory [Char] -> [Char] -> [Char]
</> [Char]
".ghci_history"))
      (Bool
True, Bool
_) -> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData
        (\[Char]
dir -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"ghci_history"))) (Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
      (Bool, Bool)
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing

    Settings GHCi -> InputT GHCi a -> GHCi a
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT
        (CompletionFunc GHCi -> Settings GHCi -> Settings GHCi
forall (m :: Type -> Type).
CompletionFunc m -> Settings m -> Settings m
setComplete CompletionFunc GHCi
ghciCompleteWord (Settings GHCi -> Settings GHCi) -> Settings GHCi -> Settings GHCi
forall a b. (a -> b) -> a -> b
$ Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings {historyFile :: Maybe [Char]
historyFile = Maybe [Char]
histFile})
        InputT GHCi a
f

-- | How to get the next input line from the user
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe [Char])
nextInputLine Bool
show_prompt Bool
is_tty
  | Bool
is_tty = do
    [Char]
prmpt <- if Bool
show_prompt then GHCi [Char] -> InputT GHCi [Char]
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt else [Char] -> InputT GHCi [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
    Maybe [Char]
r <- [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
(MonadIO m, MonadMask m) =>
[Char] -> InputT m (Maybe [Char])
getInputLine [Char]
prmpt
    InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo
    Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
r
  | Bool
otherwise = do
    Bool -> InputT GHCi () -> InputT GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
show_prompt (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ GHCi [Char] -> InputT GHCi [Char]
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt InputT GHCi [Char] -> ([Char] -> InputT GHCi ()) -> InputT GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ())
-> ([Char] -> IO ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStr
    Handle -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
stdin

-- NOTE: We only read .ghci files if they are owned by the current user,
-- and aren't world writable (files owned by root are ok, see #9324).
-- Otherwise, we could be accidentally running code planted by
-- a malicious third party.

-- Furthermore, We only read ./.ghci if . is owned by the current user
-- and isn't writable by anyone else.  I think this is sufficient: we
-- don't need to check .. and ../.. etc. because "."  always refers to
-- the same directory while a process is running.

checkFileAndDirPerms :: FilePath -> IO Bool
checkFileAndDirPerms :: [Char] -> IO Bool
checkFileAndDirPerms [Char]
file = do
  Bool
file_ok <- [Char] -> IO Bool
checkPerms [Char]
file
  -- Do not check dir perms when .ghci doesn't exist, otherwise GHCi will
  -- print some confusing and useless warnings in some cases (e.g. in
  -- travis). Note that we can't add a test for this, as all ghci tests should
  -- run with -ignore-dot-ghci, which means we never get here.
  if Bool
file_ok then [Char] -> IO Bool
checkPerms ([Char] -> [Char]
getDirectory [Char]
file) else Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
  where
  getDirectory :: [Char] -> [Char]
getDirectory [Char]
f = case [Char] -> [Char]
takeDirectory [Char]
f of
    [Char]
"" -> [Char]
"."
    [Char]
d -> [Char]
d

checkPerms :: FilePath -> IO Bool
#if defined(mingw32_HOST_OS)
checkPerms _ = return True
#else
checkPerms :: [Char] -> IO Bool
checkPerms [Char]
file =
  (IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (\IOException
_ -> Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    FileStatus
st <- [Char] -> IO FileStatus
getFileStatus [Char]
file
    UserID
me <- IO UserID
getRealUserID
    let mode :: FileMode
mode = FileStatus -> FileMode
System.Posix.fileMode FileStatus
st
        ok :: Bool
ok = (FileStatus -> UserID
fileOwner FileStatus
st UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
me Bool -> Bool -> Bool
|| FileStatus -> UserID
fileOwner FileStatus
st UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
0) Bool -> Bool -> Bool
&&
             FileMode
groupWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
mode FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
groupWriteMode Bool -> Bool -> Bool
&&
             FileMode
otherWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
mode FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
otherWriteMode
    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      -- #8248: Improving warning to include a possible fix.
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"*** WARNING: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
" is writable by someone else, IGNORING!" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                 [Char]
"\nSuggested fix: execute 'chmod go-w " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
    Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
ok
#endif

incrementLineNo :: GhciMonad m => m ()
incrementLineNo :: forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState GHCiState -> GHCiState
incLineNo
  where
    incLineNo :: GHCiState -> GHCiState
incLineNo GHCiState
st = GHCiState
st { line_number :: Int
line_number = GHCiState -> Int
line_number GHCiState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

fileLoop :: GhciMonad m => Handle -> m (Maybe String)
fileLoop :: forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
hdl = do
   Either IOException [Char]
l <- IO (Either IOException [Char]) -> m (Either IOException [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char]) -> m (Either IOException [Char]))
-> IO (Either IOException [Char]) -> m (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO (IO [Char] -> IO (Either IOException [Char]))
-> IO [Char] -> IO (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ Handle -> IO [Char]
hGetLine Handle
hdl
   case Either IOException [Char]
l of
        Left IOException
e | IOException -> Bool
isEOFError IOException
e              -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
               | -- as we share stdin with the program, the program
                 -- might have already closed it, so we might get a
                 -- handle-closed exception. We therefore catch that
                 -- too.
                 IOException -> Bool
isIllegalOperation IOException
e      -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
               | IOErrorType
InvalidArgument <- IOErrorType
etype  -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
               | Bool
otherwise                 -> IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ IOException -> IO (Maybe [Char])
forall a. IOException -> IO a
ioError IOException
e
                where etype :: IOErrorType
etype = IOException -> IOErrorType
ioeGetErrorType IOException
e
                -- treat InvalidArgument in the same way as EOF:
                -- this can happen if the user closed stdin, or
                -- perhaps did getContents which closes stdin at
                -- EOF.
        Right [Char]
l' -> do
           m ()
forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo
           Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
l')

formatCurrentTime :: String -> IO String
formatCurrentTime :: [Char] -> IO [Char]
formatCurrentTime [Char]
format =
  IO ZonedTime
getZonedTime IO ZonedTime -> (ZonedTime -> IO [Char]) -> IO [Char]
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (ZonedTime -> [Char]) -> ZonedTime -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocale -> [Char] -> ZonedTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
format)

getUserName :: IO String
getUserName :: IO [Char]
getUserName = do
#if defined(mingw32_HOST_OS)
  getEnv "USERNAME"
    `catchIO` \e -> do
      putStrLn $ show e
      return ""
#else
  IO [Char]
getLoginName
#endif

getInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)
getInfoForPrompt :: forall (m :: Type -> Type). GhciMonad m => m (SDoc, [[Char]], Int)
getInfoForPrompt = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  [InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
  [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext

  SDoc
context_bit <-
        case [Resume]
resumes of
            [] -> SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
empty
            Resume
r:[Resume]
_ -> do
                let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
                if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                   then SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
brackets (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Resume -> SrcSpan
GHC.resumeSpan Resume
r)) SDoc -> SDoc -> SDoc
<> SDoc
space)
                   else do
                        let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                        SrcSpan
pan <- History -> m SrcSpan
forall (m :: Type -> Type). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan History
hist
                        SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
brackets (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> Int
forall a. Num a => a -> a
negate Int
ix) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
                                          SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan) SDoc -> SDoc -> SDoc
<> SDoc
space)

  let
        dots :: SDoc
dots | Resume
_:[Resume]
rs <- [Resume]
resumes, Bool -> Bool
not ([Resume] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Resume]
rs) = [Char] -> SDoc
text [Char]
"... "
             | Bool
otherwise = SDoc
empty

        rev_imports :: [InteractiveImport]
rev_imports = [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a]
reverse [InteractiveImport]
imports -- rightmost are the most recent

        myIdeclName :: ImportDecl pass -> ModuleName
myIdeclName ImportDecl pass
d | Just Located ModuleName
m <- ImportDecl pass -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl pass
d = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
m
                      | Bool
otherwise           = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl pass -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl pass
d)

        modules_names :: [[Char]]
modules_names =
             [Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:(ModuleName -> [Char]
moduleNameString ModuleName
m) | IIModule ModuleName
m <- [InteractiveImport]
rev_imports] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
             [ModuleName -> [Char]
moduleNameString (ImportDecl GhcPs -> ModuleName
forall {pass}. ImportDecl pass -> ModuleName
myIdeclName ImportDecl GhcPs
d) | IIDecl ImportDecl GhcPs
d <- [InteractiveImport]
rev_imports]
        line :: Int
line = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GHCiState -> Int
line_number GHCiState
st

  (SDoc, [[Char]], Int) -> m (SDoc, [[Char]], Int)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc
dots SDoc -> SDoc -> SDoc
<> SDoc
context_bit, [[Char]]
modules_names, Int
line)

parseCallEscape :: String -> (String, String)
parseCallEscape :: [Char] -> ([Char], [Char])
parseCallEscape [Char]
s
  | Bool -> Bool
not ((Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
beforeOpen) = ([Char]
"", [Char]
"")
  | [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
sinceOpen               = ([Char]
"", [Char]
"")
  | [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
sinceClosed             = ([Char]
"", [Char]
"")
  | [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
cmd                     = ([Char]
"", [Char]
"")
  | Bool
otherwise                    = ([Char]
cmd, [Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
sinceClosed)
  where
    ([Char]
beforeOpen, [Char]
sinceOpen) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'(') [Char]
s
    ([Char]
cmd, [Char]
sinceClosed) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') ([Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
sinceOpen)

checkPromptStringForErrors :: String -> Maybe String
checkPromptStringForErrors :: [Char] -> Maybe [Char]
checkPromptStringForErrors (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) =
  case [Char] -> ([Char], [Char])
parseCallEscape [Char]
xs of
    ([Char]
"", [Char]
"") -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"Incorrect %call syntax. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                      [Char]
"Should be %call(a command and arguments).")
    ([Char]
_, [Char]
afterClosed) -> [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
afterClosed
checkPromptStringForErrors (Char
'%':Char
'%':[Char]
xs) = [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
xs
checkPromptStringForErrors (Char
_:[Char]
xs) = [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
xs
checkPromptStringForErrors [Char]
"" = Maybe [Char]
forall a. Maybe a
Nothing

generatePromptFunctionFromString :: String -> PromptFunction
generatePromptFunctionFromString :: [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
promptS [[Char]]
modules_names Int
line =
        [Char] -> GHCi SDoc
processString [Char]
promptS
  where
        processString :: String -> GHCi SDoc
        processString :: [Char] -> GHCi SDoc
processString (Char
'%':Char
's':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
modules_list) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              modules_list :: SDoc
modules_list = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
text [[Char]]
modules_names
        processString (Char
'%':Char
'l':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> GHCi SDoc) -> SDoc -> GHCi SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
line) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
'%':Char
'd':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%a %b %d"
        processString (Char
'%':Char
't':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%H:%M:%S"
        processString (Char
'%':Char
'T':[Char]
xs) = do
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%I:%M:%S"
        processString (Char
'%':Char
'@':[Char]
xs) = do
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%I:%M %P"
        processString (Char
'%':Char
'A':[Char]
xs) = do
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%H:%M"
        processString (Char
'%':Char
'u':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
user_name) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              user_name :: GHCi [Char]
user_name = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getUserName
        processString (Char
'%':Char
'w':[Char]
xs) =
            (SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
current_directory) ([Char] -> GHCi SDoc
processString [Char]
xs)
            where
              current_directory :: GHCi [Char]
current_directory = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getCurrentDirectory
        processString (Char
'%':Char
'o':[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
os) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
'%':Char
'a':[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
arch) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
'%':Char
'N':[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
compilerName) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
'%':Char
'V':[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
showVersion Version
compilerVersion) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) = do
            [Char]
respond <- IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ do
                (ExitCode
code, [Char]
out, [Char]
err) <-
                    [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode
                    ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
list_words) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
list_words) [Char]
""
                    IO (ExitCode, [Char], [Char])
-> (IOException -> IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e -> (ExitCode, [Char], [Char]) -> IO (ExitCode, [Char], [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, [Char]
"", IOException -> [Char]
forall a. Show a => a -> [Char]
show IOException
e)
                case ExitCode
code of
                    ExitCode
ExitSuccess -> [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
out
                    ExitCode
_ -> do
                        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
                        [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
respond) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
afterClosed)
            where
              ([Char]
cmd, [Char]
afterClosed) = [Char] -> ([Char], [Char])
parseCallEscape [Char]
xs
              list_words :: [[Char]]
list_words = [Char] -> [[Char]]
words [Char]
cmd
        processString (Char
'%':Char
'%':[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM ((Char -> SDoc
char Char
'%') SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString (Char
x:[Char]
xs) =
            (SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (Char -> SDoc
char Char
x SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
        processString [Char]
"" =
            SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
empty

mkPrompt :: GHCi String
mkPrompt :: GHCi [Char]
mkPrompt = do
  GHCiState
st <- GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
  (SDoc
context, [[Char]]
modules_names, Int
line) <- GHCi (SDoc, [[Char]], Int)
forall (m :: Type -> Type). GhciMonad m => m (SDoc, [[Char]], Int)
getInfoForPrompt

  SDoc
prompt_string <- (GHCiState -> PromptFunction
prompt GHCiState
st) [[Char]]
modules_names Int
line
  let prompt_doc :: SDoc
prompt_doc = SDoc
context SDoc -> SDoc -> SDoc
<> SDoc
prompt_string

  [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags SDoc
prompt_doc)

queryQueue :: GhciMonad m => m (Maybe String)
queryQueue :: forall (m :: Type -> Type). GhciMonad m => m (Maybe [Char])
queryQueue = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  case GHCiState -> [[Char]]
cmdqueue GHCiState
st of
    []   -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
    [Char]
c:[[Char]]
cs -> do GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ cmdqueue :: [[Char]]
cmdqueue = [[Char]]
cs }
               Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c)

-- Reconfigurable pretty-printing Ticket #5461
installInteractivePrint :: GHC.GhcMonad m => Maybe String -> Bool -> m ()
installInteractivePrint :: forall (m :: Type -> Type).
GhcMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint Maybe [Char]
Nothing Bool
_  = () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
installInteractivePrint (Just [Char]
ipFun) Bool
exprmode = do
  SuccessFlag
ok <- m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ do
                [Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
ipFun
                let name :: Name
name = case [Name]
names of
                             Name
name':[Name]
_ -> Name
name'
                             [] -> [Char] -> Name
forall a. [Char] -> a
panic [Char]
"installInteractivePrint"
                (HscEnv -> HscEnv) -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(HscEnv -> HscEnv) -> m ()
modifySession (\HscEnv
he -> let new_ic :: InteractiveContext
new_ic = InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName (HscEnv -> InteractiveContext
hsc_IC HscEnv
he) Name
name
                                      in HscEnv
he{hsc_IC :: InteractiveContext
hsc_IC = InteractiveContext
new_ic})
                SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Succeeded

  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (SuccessFlag -> Bool
failed SuccessFlag
ok Bool -> Bool -> Bool
&& Bool
exprmode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1))

-- | The main read-eval-print loop
runCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()
runCommands :: InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands InputT GHCi (Maybe [Char])
gCmd = (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
forall (m :: Type -> Type). GhciMonad m => SomeException -> m Bool
handler Maybe (GHCi ())
forall a. Maybe a
Nothing InputT GHCi (Maybe [Char])
gCmd InputT GHCi () -> InputT GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

runCommands' :: (SomeException -> GHCi Bool) -- ^ Exception handler
             -> Maybe (GHCi ()) -- ^ Source error handler
             -> InputT GHCi (Maybe String)
             -> InputT GHCi ()
runCommands' :: (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
eh Maybe (GHCi ())
sourceErrorHandler InputT GHCi (Maybe [Char])
gCmd = ((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi ())
-> InputT GHCi ()
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi ())
 -> InputT GHCi ())
-> ((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi ())
-> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ \forall a. InputT GHCi a -> InputT GHCi a
unmask -> do
    Maybe Bool
b <- (SomeException -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\SomeException
e -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                          Just AsyncException
UserInterrupt -> Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> InputT GHCi (Maybe Bool))
-> Maybe Bool -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                          Maybe AsyncException
_ -> case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                                 Just GhcException
ghce ->
                                   do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (GhcException -> IO ()
forall a. Show a => a -> IO ()
print (GhcException
ghce :: GhcException))
                                      Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
                                 Maybe GhcException
_other ->
                                   IO (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO (Maybe Bool)
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e))
            (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a. InputT GHCi a -> InputT GHCi a
unmask (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ (SomeException -> GHCi Bool)
-> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool)
runOneCommand SomeException -> GHCi Bool
eh InputT GHCi (Maybe [Char])
gCmd)
    case Maybe Bool
b of
      Maybe Bool
Nothing -> () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
      Just Bool
success -> do
        Bool -> InputT GHCi () -> InputT GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
success (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ InputT GHCi ()
-> (GHCi () -> InputT GHCi ()) -> Maybe (GHCi ()) -> InputT GHCi ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) GHCi () -> InputT GHCi ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Maybe (GHCi ())
sourceErrorHandler
        InputT GHCi () -> InputT GHCi ()
forall a. InputT GHCi a -> InputT GHCi a
unmask (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
eh Maybe (GHCi ())
sourceErrorHandler InputT GHCi (Maybe [Char])
gCmd

-- | Evaluate a single line of user input (either :<command> or Haskell code).
-- A result of Nothing means there was no more input to process.
-- Otherwise the result is Just b where b is True if the command succeeded;
-- this is relevant only to ghc -e, which will exit with status 1
-- if the command was unsuccessful. GHCi will continue in either case.
runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String)
            -> InputT GHCi (Maybe Bool)
runOneCommand :: (SomeException -> GHCi Bool)
-> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool)
runOneCommand SomeException -> GHCi Bool
eh InputT GHCi (Maybe [Char])
gCmd = do
  -- run a previously queued command if there is one, otherwise get new
  -- input from user
  Maybe [Char]
mb_cmd0 <- InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall {m :: Type -> Type}.
GhciMonad m =>
m (Maybe [Char]) -> m (Maybe [Char])
noSpace (GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi (Maybe [Char])
forall (m :: Type -> Type). GhciMonad m => m (Maybe [Char])
queryQueue)
  Maybe [Char]
mb_cmd1 <- InputT GHCi (Maybe [Char])
-> ([Char] -> InputT GHCi (Maybe [Char]))
-> Maybe [Char]
-> InputT GHCi (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall {m :: Type -> Type}.
GhciMonad m =>
m (Maybe [Char]) -> m (Maybe [Char])
noSpace InputT GHCi (Maybe [Char])
gCmd) (Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> InputT GHCi (Maybe [Char]))
-> ([Char] -> Maybe [Char]) -> [Char] -> InputT GHCi (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just) Maybe [Char]
mb_cmd0
  case Maybe [Char]
mb_cmd1 of
    Maybe [Char]
Nothing -> Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
    Just [Char]
c  -> do
      GHCiState
st <- InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      (SomeException -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
e -> GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ SomeException -> GHCi Bool
eh SomeException
e GHCi Bool -> (Bool -> GHCi (Maybe Bool)) -> GHCi (Maybe Bool)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Bool -> GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> GHCi (Maybe Bool))
-> (Bool -> Maybe Bool) -> Bool -> GHCi (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool
forall a. a -> Maybe a
Just) (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
        (SourceError -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> InputT GHCi (Maybe Bool)
forall {m :: Type -> Type}.
GhcMonad m =>
SourceError -> m (Maybe Bool)
printErrorAndFail (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
          GHCiState -> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
cmd_wrapper GHCiState
st (InputT GHCi CommandResult -> InputT GHCi (Maybe Bool))
-> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT GHCi CommandResult
doCommand [Char]
c
               -- source error's are handled by runStmt
               -- is the handler necessary here?
  where
    printErrorAndFail :: SourceError -> m (Maybe Bool)
printErrorAndFail SourceError
err = do
        SourceError -> m ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
err
        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
False     -- Exit ghc -e, but not GHCi

    noSpace :: m (Maybe [Char]) -> m (Maybe [Char])
noSpace m (Maybe [Char])
q = m (Maybe [Char])
q m (Maybe [Char])
-> (Maybe [Char] -> m (Maybe [Char])) -> m (Maybe [Char])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe [Char])
-> ([Char] -> m (Maybe [Char])) -> Maybe [Char] -> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
                            (\[Char]
c -> case [Char] -> [Char]
removeSpaces [Char]
c of
                                     [Char]
""   -> m (Maybe [Char]) -> m (Maybe [Char])
noSpace m (Maybe [Char])
q
                                     [Char]
":{" -> m (Maybe [Char]) -> m (Maybe [Char])
forall {m :: Type -> Type}.
GhciMonad m =>
m (Maybe [Char]) -> m (Maybe [Char])
multiLineCmd m (Maybe [Char])
q
                                     [Char]
_    -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c) )
    multiLineCmd :: m (Maybe [Char]) -> m (Maybe [Char])
multiLineCmd m (Maybe [Char])
q = do
      GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
      let p :: PromptFunction
p = GHCiState -> PromptFunction
prompt GHCiState
st
      GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ prompt :: PromptFunction
prompt = GHCiState -> PromptFunction
prompt_cont GHCiState
st }
      Maybe [Char]
mb_cmd <- m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
forall {m :: Type -> Type}.
MonadIO m =>
m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q [Char]
"" m (Maybe [Char]) -> m () -> m (Maybe [Char])
forall (m :: Type -> Type) a b. MonadMask m => m a -> m b -> m a
`MC.finally`
                (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st' -> GHCiState
st' { prompt :: PromptFunction
prompt = PromptFunction
p })
      Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
mb_cmd
    -- we can't use removeSpaces for the sublines here, so
    -- multiline commands are somewhat more brittle against
    -- fileformat errors (such as \r in dos input on unix),
    -- we get rid of any extra spaces for the ":}" test;
    -- we also avoid silent failure if ":}" is not found;
    -- and since there is no (?) valid occurrence of \r (as
    -- opposed to its String representation, "\r") inside a
    -- ghci command, we replace any such with ' ' (argh:-(
    collectCommand :: m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q [Char]
c = m (Maybe [Char])
q m (Maybe [Char])
-> (Maybe [Char] -> m (Maybe [Char])) -> m (Maybe [Char])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      m (Maybe [Char])
-> ([Char] -> m (Maybe [Char])) -> Maybe [Char] -> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IOException -> IO (Maybe [Char])
forall a. IOException -> IO a
ioError IOException
collectError))
            (\[Char]
l->if [Char] -> [Char]
removeSpaces [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
":}"
                 then Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c)
                 else m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q ([Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
normSpace [Char]
l))
      where normSpace :: Char -> Char
normSpace Char
'\r' = Char
' '
            normSpace   Char
x  = Char
x
    -- SDM (2007-11-07): is userError the one to use here?
    collectError :: IOException
collectError = [Char] -> IOException
userError [Char]
"unterminated multiline command :{ .. :}"

    -- | Handle a line of input
    doCommand :: String -> InputT GHCi CommandResult

    -- command
    doCommand :: [Char] -> InputT GHCi CommandResult
doCommand [Char]
stmt | stmt' :: [Char]
stmt'@(Char
':' : [Char]
cmd) <- [Char] -> [Char]
removeSpaces [Char]
stmt = do
      (ActionStats
stats, Either SomeException Bool
result) <- (Bool -> Maybe Integer)
-> InputT GHCi Bool
-> InputT GHCi (ActionStats, Either SomeException Bool)
forall (m :: Type -> Type) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats (Maybe Integer -> Bool -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) (InputT GHCi Bool
 -> InputT GHCi (ActionStats, Either SomeException Bool))
-> InputT GHCi Bool
-> InputT GHCi (ActionStats, Either SomeException Bool)
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT GHCi Bool
specialCommand [Char]
cmd
      let processResult :: Bool -> Maybe Bool
processResult Bool
True = Maybe Bool
forall a. Maybe a
Nothing
          processResult Bool
False = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$ [Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
stmt' (Bool -> Maybe Bool
processResult (Bool -> Maybe Bool)
-> Either SomeException Bool -> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException Bool
result) ActionStats
stats

    -- haskell
    doCommand [Char]
stmt = do
      -- if 'stmt' was entered via ':{' it will contain '\n's
      let stmt_nl_cnt :: Int
stmt_nl_cnt = [()] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ () | Char
'\n' <- [Char]
stmt ]
      Bool
ml <- GHCi Bool -> InputT GHCi Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool) -> GHCi Bool -> InputT GHCi Bool
forall a b. (a -> b) -> a -> b
$ GHCiOption -> GHCi Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
Multiline
      if Bool
ml Bool -> Bool -> Bool
&& Int
stmt_nl_cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -- don't trigger automatic multi-line mode for ':{'-multiline input
        then do
          Int
fst_line_num <- GHCiState -> Int
line_number (GHCiState -> Int) -> InputT GHCi GHCiState -> InputT GHCi Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
          Maybe [Char]
mb_stmt <- [Char] -> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
checkInputForLayout [Char]
stmt InputT GHCi (Maybe [Char])
gCmd
          case Maybe [Char]
mb_stmt of
            Maybe [Char]
Nothing -> CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return CommandResult
CommandIncomplete
            Just [Char]
ml_stmt -> do
              -- temporarily compensate line-number for multi-line input
              (ActionStats
stats, Either SomeException (Maybe ExecResult)
result) <- (Maybe ExecResult -> Maybe Integer)
-> InputT GHCi (Maybe ExecResult)
-> InputT
     GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runAndPrintStats Maybe ExecResult -> Maybe Integer
runAllocs (InputT GHCi (Maybe ExecResult)
 -> InputT
      GHCi (ActionStats, Either SomeException (Maybe ExecResult)))
-> InputT GHCi (Maybe ExecResult)
-> InputT
     GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall a b. (a -> b) -> a -> b
$ GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$
                Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
fst_line_num [Char]
ml_stmt SingleStep
GHC.RunToCompletion
              CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$
                [Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
ml_stmt (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Maybe ExecResult -> Bool) -> Maybe ExecResult -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ExecResult -> Bool
runSuccess (Maybe ExecResult -> Maybe Bool)
-> Either SomeException (Maybe ExecResult)
-> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Maybe ExecResult)
result) ActionStats
stats
        else do -- single line input and :{ - multiline input
          Int
last_line_num <- GHCiState -> Int
line_number (GHCiState -> Int) -> InputT GHCi GHCiState -> InputT GHCi Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
          -- reconstruct first line num from last line num and stmt
          let fst_line_num :: Int
fst_line_num | Int
stmt_nl_cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int
last_line_num Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
stmt_nl_cnt2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                           | Bool
otherwise = Int
last_line_num -- single line input
              stmt_nl_cnt2 :: Int
stmt_nl_cnt2 = [()] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ () | Char
'\n' <- [Char]
stmt' ]
              stmt' :: [Char]
stmt' = [Char] -> [Char]
dropLeadingWhiteLines [Char]
stmt -- runStmt doesn't like leading empty lines
          -- temporarily compensate line-number for multi-line input
          (ActionStats
stats, Either SomeException (Maybe ExecResult)
result) <- (Maybe ExecResult -> Maybe Integer)
-> InputT GHCi (Maybe ExecResult)
-> InputT
     GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runAndPrintStats Maybe ExecResult -> Maybe Integer
runAllocs (InputT GHCi (Maybe ExecResult)
 -> InputT
      GHCi (ActionStats, Either SomeException (Maybe ExecResult)))
-> InputT GHCi (Maybe ExecResult)
-> InputT
     GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall a b. (a -> b) -> a -> b
$ GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$
            Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
fst_line_num [Char]
stmt' SingleStep
GHC.RunToCompletion
          CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$ [Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
stmt' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Maybe ExecResult -> Bool) -> Maybe ExecResult -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ExecResult -> Bool
runSuccess (Maybe ExecResult -> Maybe Bool)
-> Either SomeException (Maybe ExecResult)
-> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Maybe ExecResult)
result) ActionStats
stats

    -- runStmt wrapper for temporarily overridden line-number
    runStmtWithLineNum :: Int -> String -> SingleStep
                       -> GHCi (Maybe GHC.ExecResult)
    runStmtWithLineNum :: Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
lnum [Char]
stmt SingleStep
step = do
        GHCiState
st0 <- GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
        GHCiState -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st0 { line_number :: Int
line_number = Int
lnum }
        Maybe ExecResult
result <- [Char] -> SingleStep -> GHCi (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
stmt SingleStep
step
        -- restore original line_number
        GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState GHCi GHCiState -> (GHCiState -> GHCi ()) -> GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GHCiState
st -> GHCiState -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st { line_number :: Int
line_number = GHCiState -> Int
line_number GHCiState
st0 }
        Maybe ExecResult -> GHCi (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
result

    -- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines'
    dropLeadingWhiteLines :: [Char] -> [Char]
dropLeadingWhiteLines [Char]
s | ([Char]
l0,Char
'\n':[Char]
r) <- (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') [Char]
s
                            , (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
l0 = [Char] -> [Char]
dropLeadingWhiteLines [Char]
r
                            | Bool
otherwise = [Char]
s


-- #4316
-- lex the input.  If there is an unclosed layout context, request input
checkInputForLayout
  :: GhciMonad m => String -> m (Maybe String) -> m (Maybe String)
checkInputForLayout :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
checkInputForLayout [Char]
stmt m (Maybe [Char])
getStmt = do
   DynFlags
dflags' <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
   let dflags :: DynFlags
dflags = DynFlags -> Extension -> DynFlags
xopt_set DynFlags
dflags' Extension
LangExt.AlternativeLayoutRule
   GHCiState
st0 <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
   let buf' :: StringBuffer
buf'   =  [Char] -> StringBuffer
stringToStringBuffer [Char]
stmt
       loc :: RealSrcLoc
loc    = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc ([Char] -> FastString
fsLit (GHCiState -> [Char]
progname GHCiState
st0)) (GHCiState -> Int
line_number GHCiState
st0) Int
1
       pstate :: PState
pstate = DynFlags -> StringBuffer -> RealSrcLoc -> PState
Lexer.mkPState DynFlags
dflags StringBuffer
buf' RealSrcLoc
loc
   case P Bool -> PState -> ParseResult Bool
forall a. P a -> PState -> ParseResult a
Lexer.unP P Bool
goToEnd PState
pstate of
     (Lexer.POk PState
_ Bool
False) -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stmt
     ParseResult Bool
_other              -> do
       GHCiState
st1 <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
       let p :: PromptFunction
p = GHCiState -> PromptFunction
prompt GHCiState
st1
       GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st1{ prompt :: PromptFunction
prompt = GHCiState -> PromptFunction
prompt_cont GHCiState
st1 }
       Maybe [Char]
mb_stmt <- (SomeException -> m (Maybe [Char]))
-> m (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
ex -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
                            Just AsyncException
UserInterrupt -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                            Maybe AsyncException
_ -> case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
                                 Just GhcException
ghce ->
                                   do IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (GhcException -> IO ()
forall a. Show a => a -> IO ()
print (GhcException
ghce :: GhcException))
                                      Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                                 Maybe GhcException
_other -> IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO (Maybe [Char])
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
ex))
                     m (Maybe [Char])
getStmt
       (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st' -> GHCiState
st' { prompt :: PromptFunction
prompt = PromptFunction
p })
       -- the recursive call does not recycle parser state
       -- as we use a new string buffer
       case Maybe [Char]
mb_stmt of
         Maybe [Char]
Nothing  -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
         Just [Char]
str -> if [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
           then Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stmt
           else do
             [Char] -> m (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
checkInputForLayout ([Char]
stmt[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
str) m (Maybe [Char])
getStmt
     where goToEnd :: P Bool
goToEnd = do
             Bool
eof <- P Bool
Lexer.nextIsEOF
             if Bool
eof
               then P Bool
Lexer.activeContext
               else Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
Lexer.lexer Bool
False Located Token -> P (Located Token)
forall (m :: Type -> Type) a. Monad m => a -> m a
return P (Located Token) -> P Bool -> P Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> P Bool
goToEnd

enqueueCommands :: GhciMonad m => [String] -> m ()
enqueueCommands :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]]
cmds = do
  -- make sure we force any exceptions in the commands while we're
  -- still inside the exception handler, otherwise bad things will
  -- happen (see #10501)
  [[Char]]
cmds [[Char]] -> m () -> m ()
forall a b. NFData a => a -> b -> b
`deepseq` () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
  (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState ((GHCiState -> GHCiState) -> m ())
-> (GHCiState -> GHCiState) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCiState
st -> GHCiState
st{ cmdqueue :: [[Char]]
cmdqueue = [[Char]]
cmds [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ GHCiState -> [[Char]]
cmdqueue GHCiState
st }

-- | Entry point to execute some haskell code from user.
-- The return value True indicates success, as in `runOneCommand`.
runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
runStmt :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
input SingleStep
step = do
  ParserFlags
pflags <- DynFlags -> ParserFlags
Lexer.mkParserFlags (DynFlags -> ParserFlags) -> m DynFlags -> m ParserFlags
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
  -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
  -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
  -- declarations and statements are not affected.
  -- See Note [Deferred type errors in GHCi] in GHC.Tc.Module
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  let source :: [Char]
source = GHCiState -> [Char]
progname GHCiState
st
  let line :: Int
line = GHCiState -> Int
line_number GHCiState
st

  if | ParserFlags -> [Char] -> Bool
GHC.isStmt ParserFlags
pflags [Char]
input -> do
         HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
         Maybe (GhciLStmt GhcPs)
mb_stmt <- IO (Maybe (GhciLStmt GhcPs)) -> m (Maybe (GhciLStmt GhcPs))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv
-> Hsc (Maybe (GhciLStmt GhcPs)) -> IO (Maybe (GhciLStmt GhcPs))
forall a. HscEnv -> Hsc a -> IO a
runInteractiveHsc HscEnv
hsc_env ([Char] -> Int -> [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
hscParseStmtWithLocation [Char]
source Int
line [Char]
input))
         case Maybe (GhciLStmt GhcPs)
mb_stmt of
           Maybe (GhciLStmt GhcPs)
Nothing ->
             -- empty statement / comment
             Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just ExecResult
exec_complete)
           Just GhciLStmt GhcPs
stmt ->
             GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt GhciLStmt GhcPs
stmt

     | ParserFlags -> [Char] -> Bool
GHC.isImport ParserFlags
pflags [Char]
input -> m (Maybe ExecResult)
run_import

     -- Every import declaration should be handled by `run_import`. As GHCi
     -- in general only accepts one command at a time, we simply throw an
     -- exception when the input contains multiple commands of which at least
     -- one is an import command (see #10663).
     | ParserFlags -> [Char] -> Bool
GHC.hasImport ParserFlags
pflags [Char]
input -> GhcException -> m (Maybe ExecResult)
forall a. GhcException -> a
throwGhcException
       ([Char] -> GhcException
CmdLineError [Char]
"error: expecting a single import declaration")

     -- Otherwise assume a declaration (or a list of declarations)
     -- Note: `GHC.isDecl` returns False on input like
     -- `data Infix a b = a :@: b; infixl 4 :@:`
     -- and should therefore not be used here.
     | Bool
otherwise -> do
         HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
         [LHsDecl GhcPs]
decls <- IO [LHsDecl GhcPs] -> m [LHsDecl GhcPs]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> [Char] -> Int -> [Char] -> IO [LHsDecl GhcPs]
hscParseDeclsWithLocation HscEnv
hsc_env [Char]
source Int
line [Char]
input)
         [LHsDecl GhcPs] -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe ExecResult)
run_decls [LHsDecl GhcPs]
decls
  where
    exec_complete :: ExecResult
exec_complete = Either SomeException [Name] -> Word64 -> ExecResult
GHC.ExecComplete ([Name] -> Either SomeException [Name]
forall a b. b -> Either a b
Right []) Word64
0

    run_import :: m (Maybe ExecResult)
run_import = do
      [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
addImportToContext [Char]
input
      Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just ExecResult
exec_complete)

    run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)
    run_stmt :: forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt GhciLStmt GhcPs
stmt = do
           Maybe ExecResult
m_result <- GhciLStmt GhcPs -> [Char] -> SingleStep -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> [Char] -> SingleStep -> m (Maybe ExecResult)
GhciMonad.runStmt GhciLStmt GhcPs
stmt [Char]
input SingleStep
step
           case Maybe ExecResult
m_result of
               Maybe ExecResult
Nothing     -> Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
forall a. Maybe a
Nothing
               Just ExecResult
result -> 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
<$> (SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) ExecResult
result

    -- `x = y` (a declaration) should be treated as `let x = y` (a statement).
    -- The reason is because GHCi wasn't designed to support `x = y`, but then
    -- b98ff3 (#7253) added support for it, except it did not do a good job and
    -- caused problems like:
    --
    --  - not adding the binders defined this way in the necessary places caused
    --    `x = y` to not work in some cases (#12091).
    --  - some GHCi command crashed after `x = y` (#15721)
    --  - warning generation did not work for `x = y` (#11606)
    --  - because `x = y` is a declaration (instead of a statement) differences
    --    in generated code caused confusion (#16089)
    --
    -- Instead of dealing with all these problems individually here we fix this
    -- mess by just treating `x = y` as `let x = y`.
    run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
    -- Only turn `FunBind` and `VarBind` into statements, other bindings
    -- (e.g. `PatBind`) need to stay as decls.
    run_decls :: forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe ExecResult)
run_decls [L SrcSpan
l (ValD XValD GhcPs
_ bind :: HsBind GhcPs
bind@FunBind{})] = GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt (SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
l HsBind GhcPs
bind)
    run_decls [L SrcSpan
l (ValD XValD GhcPs
_ bind :: HsBind GhcPs
bind@VarBind{})] = GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt (SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
l HsBind GhcPs
bind)
    -- Note that any `x = y` declarations below will be run as declarations
    -- instead of statements (e.g. `...; x = y; ...`)
    run_decls [LHsDecl GhcPs]
decls = do
      -- In the new IO library, read handles buffer data even if the Handle
      -- is set to NoBuffering.  This causes problems for GHCi where there
      -- are really two stdin Handles.  So we flush any bufferred data in
      -- GHCi's stdin Handle here (only relevant if stdin is attached to
      -- a file, otherwise the read buffer can't be flushed).
      Either IOException ()
_ <- IO (Either IOException ()) -> m (Either IOException ())
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ()) -> m (Either IOException ()))
-> IO (Either IOException ()) -> m (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlushAll Handle
stdin
      Maybe [Name]
m_result <- [LHsDecl GhcPs] -> m (Maybe [Name])
forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe [Name])
GhciMonad.runDecls' [LHsDecl GhcPs]
decls
      Maybe [Name] -> ([Name] -> m ExecResult) -> m (Maybe ExecResult)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe [Name]
m_result (([Name] -> m ExecResult) -> m (Maybe ExecResult))
-> ([Name] -> m ExecResult) -> m (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$ \[Name]
result ->
        (SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) (Either SomeException [Name] -> Word64 -> ExecResult
GHC.ExecComplete ([Name] -> Either SomeException [Name]
forall a b. b -> Either a b
Right [Name]
result) Word64
0)

    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
    mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
loc HsBind GhcPs
bind =
      let l :: e -> GenLocated SrcSpan e
l = SrcSpan -> e -> GenLocated SrcSpan e
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc
      in StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GhciLStmt GhcPs
forall {e}. e -> GenLocated SrcSpan e
l (XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsLocalBindsLR GhcPs GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
NoExtField
noExtField (HsLocalBindsLR GhcPs GhcPs -> LHsLocalBindsLR GhcPs GhcPs
forall {e}. e -> GenLocated SrcSpan e
l (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField
noExtField (XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
NoExtField
noExtField (GenLocated SrcSpan (HsBind GhcPs) -> LHsBindsLR GhcPs GhcPs
forall a. a -> Bag a
unitBag (HsBind GhcPs -> GenLocated SrcSpan (HsBind GhcPs)
forall {e}. e -> GenLocated SrcSpan e
l HsBind GhcPs
bind)) []))))

-- | Clean up the GHCi environment after a statement has run
afterRunStmt :: GhciMonad m
             => (SrcSpan -> Bool) -> GHC.ExecResult -> m GHC.ExecResult
afterRunStmt :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt SrcSpan -> Bool
step_here ExecResult
run_result = do
  [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
  case ExecResult
run_result of
     GHC.ExecComplete{Word64
Either SomeException [Name]
execAllocation :: ExecResult -> Word64
execResult :: ExecResult -> Either SomeException [Name]
execAllocation :: Word64
execResult :: Either SomeException [Name]
..} ->
       case Either SomeException [Name]
execResult of
          Left SomeException
ex -> 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
$ SomeException -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
ex
          Right [Name]
names -> do
            Bool
show_types <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
ShowType
            Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
show_types (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
     GHC.ExecBreak [Name]
names Maybe BreakInfo
mb_info
         | Maybe BreakInfo -> Bool
forall a. Maybe a -> Bool
isNothing  Maybe BreakInfo
mb_info Bool -> Bool -> Bool
||
           SrcSpan -> Bool
step_here (Resume -> SrcSpan
GHC.resumeSpan (Resume -> SrcSpan) -> Resume -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [Resume] -> Resume
forall a. [a] -> a
head [Resume]
resumes) -> do
               Maybe (Int, BreakLocation)
mb_id_loc <- Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type).
GhciMonad m =>
Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Maybe BreakInfo
mb_info
               let bCmd :: [Char]
bCmd = [Char]
-> ((Int, BreakLocation) -> [Char])
-> Maybe (Int, BreakLocation)
-> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ( \(Int
_,BreakLocation
l) -> BreakLocation -> [Char]
onBreakCmd BreakLocation
l ) Maybe (Int, BreakLocation)
mb_id_loc
               if ([Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
bCmd)
                 then Resume -> [Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo ([Resume] -> Resume
forall a. [a] -> a
head [Resume]
resumes) [Name]
names
                 else [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]
bCmd]
               -- run the command set with ":set stop <cmd>"
               GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
               [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [GHCiState -> [Char]
stop GHCiState
st]
               () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
         | Bool
otherwise -> (SrcSpan -> Bool) -> SingleStep -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ExecResult
resume SrcSpan -> Bool
step_here SingleStep
GHC.SingleStep m ExecResult -> (ExecResult -> m ExecResult) -> m ExecResult
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        (SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt SrcSpan -> Bool
step_here m ExecResult -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

  m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
  m () -> m ()
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m a
withSignalHandlers (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
     Bool
b <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
RevertCAFs
     Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
forall (m :: Type -> Type). GhciMonad m => m ()
revertCAFs

  ExecResult -> m ExecResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExecResult
run_result

runSuccess :: Maybe GHC.ExecResult -> Bool
runSuccess :: Maybe ExecResult -> Bool
runSuccess Maybe ExecResult
run_result
  | Just (GHC.ExecComplete { execResult :: ExecResult -> Either SomeException [Name]
execResult = Right [Name]
_ }) <- Maybe ExecResult
run_result = Bool
True
  | Bool
otherwise = Bool
False

runAllocs :: Maybe GHC.ExecResult -> Maybe Integer
runAllocs :: Maybe ExecResult -> Maybe Integer
runAllocs Maybe ExecResult
m = do
  ExecResult
res <- Maybe ExecResult
m
  case ExecResult
res of
    GHC.ExecComplete{Word64
Either SomeException [Name]
execAllocation :: Word64
execResult :: Either SomeException [Name]
execAllocation :: ExecResult -> Word64
execResult :: ExecResult -> Either SomeException [Name]
..} -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
execAllocation)
    ExecResult
_ -> Maybe Integer
forall a. Maybe a
Nothing

toBreakIdAndLocation :: GhciMonad m
                     => Maybe GHC.BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation :: forall (m :: Type -> Type).
GhciMonad m =>
Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Maybe BreakInfo
Nothing = Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Int, BreakLocation)
forall a. Maybe a
Nothing
toBreakIdAndLocation (Just BreakInfo
inf) = do
  let md :: Module
md = BreakInfo -> Module
GHC.breakInfo_module BreakInfo
inf
      nm :: Int
nm = BreakInfo -> Int
GHC.breakInfo_number BreakInfo
inf
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation)))
-> Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall a b. (a -> b) -> a -> b
$ [(Int, BreakLocation)] -> Maybe (Int, BreakLocation)
forall a. [a] -> Maybe a
listToMaybe [ (Int, BreakLocation)
id_loc | id_loc :: (Int, BreakLocation)
id_loc@(Int
_,BreakLocation
loc) <- IntMap BreakLocation -> [(Int, BreakLocation)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (GHCiState -> IntMap BreakLocation
breaks GHCiState
st),
                                  BreakLocation -> Module
breakModule BreakLocation
loc Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
md,
                                  BreakLocation -> Int
breakTick BreakLocation
loc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nm ]

printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo :: forall (m :: Type -> Type). GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo Resume
res [Name]
names = do
  SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ Resume -> SDoc
pprStopped Resume
res
  --  printTypeOfNames session names
  let namesSorted :: [Name]
namesSorted = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
compareNames [Name]
names
  [TyThing]
tythings <- [Maybe TyThing] -> [TyThing]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TyThing] -> [TyThing]) -> m [Maybe TyThing] -> m [TyThing]
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
`liftM` (Name -> m (Maybe TyThing)) -> [Name] -> m [Maybe TyThing]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName [Name]
namesSorted
  [SDoc]
docs <- (Id -> m SDoc) -> [Id] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Id -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Id -> m SDoc
pprTypeAndContents [Id
i | AnId Id
i <- [TyThing]
tythings]
  SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUserPartWay (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [SDoc]
docs

printTypeOfNames :: GHC.GhcMonad m => [Name] -> m ()
printTypeOfNames :: forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
 = (Name -> m ()) -> [Name] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name -> m ()
forall (m :: Type -> Type). GhcMonad m => Name -> m ()
printTypeOfName ) ([Name] -> m ()) -> [Name] -> m ()
forall a b. (a -> b) -> a -> b
$ (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
compareNames [Name]
names

compareNames :: Name -> Name -> Ordering
Name
n1 compareNames :: Name -> Name -> Ordering
`compareNames` Name
n2 =
  ([Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (Name -> [Char]) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> [Char]
forall a. NamedThing a => a -> [Char]
getOccString) Name
n1 Name
n2 Ordering -> Ordering -> Ordering
`thenCmp`
  (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan) Name
n1 Name
n2

printTypeOfName :: GHC.GhcMonad m => Name -> m ()
printTypeOfName :: forall (m :: Type -> Type). GhcMonad m => Name -> m ()
printTypeOfName Name
n
   = do Maybe TyThing
maybe_tything <- Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName Name
n
        case Maybe TyThing
maybe_tything of
            Maybe TyThing
Nothing    -> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
            Just TyThing
thing -> TyThing -> m ()
forall (m :: Type -> Type). GhcMonad m => TyThing -> m ()
printTyThing TyThing
thing


data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand

-- | Entry point for execution a ':<command>' input from user
specialCommand :: String -> InputT GHCi Bool
specialCommand :: [Char] -> InputT GHCi Bool
specialCommand (Char
'!':[Char]
str) = GHCi Bool -> InputT GHCi Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool) -> GHCi Bool -> InputT GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> GHCi Bool
forall (m :: Type -> Type). MonadIO m => [Char] -> m Bool
shellEscape ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
str)
specialCommand [Char]
str = do
  let ([Char]
cmd,[Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
str
  MaybeCommand
maybe_cmd <- [Char] -> InputT GHCi MaybeCommand
forall (m :: Type -> Type). GhciMonad m => [Char] -> m MaybeCommand
lookupCommand [Char]
cmd
  [Char]
htxt <- GHCiState -> [Char]
short_help (GHCiState -> [Char])
-> InputT GHCi GHCiState -> InputT GHCi [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  case MaybeCommand
maybe_cmd of
    GotCommand Command
cmd -> (Command -> [Char] -> InputT GHCi Bool
cmdAction Command
cmd) ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
    MaybeCommand
BadCommand ->
      do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
stdout ([Char]
"unknown command ':" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'\n"
                           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
htxt)
         Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
    MaybeCommand
NoLastCommand ->
      do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
stdout ([Char]
"there is no last command to perform\n"
                           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
htxt)
         Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False

shellEscape :: MonadIO m => String -> m Bool
shellEscape :: forall (m :: Type -> Type). MonadIO m => [Char] -> m Bool
shellEscape [Char]
str = IO Bool -> m Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ExitCode
system [Char]
str IO ExitCode -> IO Bool -> IO Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False)

lookupCommand :: GhciMonad m => String -> m (MaybeCommand)
lookupCommand :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m MaybeCommand
lookupCommand [Char]
"" = do
  GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  case GHCiState -> Maybe Command
last_command GHCiState
st of
      Just Command
c -> MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MaybeCommand -> m MaybeCommand) -> MaybeCommand -> m MaybeCommand
forall a b. (a -> b) -> a -> b
$ Command -> MaybeCommand
GotCommand Command
c
      Maybe Command
Nothing -> MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return MaybeCommand
NoLastCommand
lookupCommand [Char]
str = do
  Maybe Command
mc <- [Char] -> m (Maybe Command)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
str
  (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { last_command :: Maybe Command
last_command = Maybe Command
mc })
  MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MaybeCommand -> m MaybeCommand) -> MaybeCommand -> m MaybeCommand
forall a b. (a -> b) -> a -> b
$ case Maybe Command
mc of
           Just Command
c -> Command -> MaybeCommand
GotCommand Command
c
           Maybe Command
Nothing -> MaybeCommand
BadCommand

lookupCommand' :: GhciMonad m => String -> m (Maybe Command)
lookupCommand' :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
":" = Maybe Command -> m (Maybe Command)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Command
forall a. Maybe a
Nothing
lookupCommand' [Char]
str' = do
  [Command]
macros    <- GHCiState -> [Command]
ghci_macros (GHCiState -> [Command]) -> m GHCiState -> m [Command]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
  [Command]
ghci_cmds <- GHCiState -> [Command]
ghci_commands (GHCiState -> [Command]) -> m GHCiState -> m [Command]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState

  let ghci_cmds_nohide :: [Command]
ghci_cmds_nohide = (Command -> Bool) -> [Command] -> [Command]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Command -> Bool) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Bool
cmdHidden) [Command]
ghci_cmds

  let ([Char]
str, [Command]
xcmds) = case [Char]
str' of
          Char
':' : [Char]
rest -> ([Char]
rest, [])     -- "::" selects a builtin command
          [Char]
_          -> ([Char]
str', [Command]
macros) -- otherwise include macros in lookup

      lookupExact :: [Char] -> t Command -> Maybe Command
lookupExact  [Char]
s = (Command -> Bool) -> t Command -> Maybe Command
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find ((Command -> Bool) -> t Command -> Maybe Command)
-> (Command -> Bool) -> t Command -> Maybe Command
forall a b. (a -> b) -> a -> b
$ ([Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==)              ([Char] -> Bool) -> (Command -> [Char]) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> [Char]
cmdName
      lookupPrefix :: [Char] -> t Command -> Maybe Command
lookupPrefix [Char]
s = (Command -> Bool) -> t Command -> Maybe Command
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find ((Command -> Bool) -> t Command -> Maybe Command)
-> (Command -> Bool) -> t Command -> Maybe Command
forall a b. (a -> b) -> a -> b
$ ([Char]
s [Char] -> [Char] -> Bool
`isPrefixOptOf`) ([Char] -> Bool) -> (Command -> [Char]) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> [Char]
cmdName

      -- hidden commands can only be matched exact
      builtinPfxMatch :: Maybe Command
builtinPfxMatch = [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupPrefix [Char]
str [Command]
ghci_cmds_nohide

  -- first, look for exact match (while preferring macros); then, look
  -- for first prefix match (preferring builtins), *unless* a macro
  -- overrides the builtin; see #8305 for motivation
  Maybe Command -> m (Maybe Command)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Command -> m (Maybe Command))
-> Maybe Command -> m (Maybe Command)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact [Char]
str [Command]
xcmds Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
           [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact [Char]
str [Command]
ghci_cmds Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
           (Maybe Command
builtinPfxMatch Maybe Command -> (Command -> Maybe Command) -> Maybe Command
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Command
c -> [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact (Command -> [Char]
cmdName Command
c) [Command]
xcmds) Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
           Maybe Command
builtinPfxMatch Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
           [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupPrefix [Char]
str [Command]
xcmds

-- This predicate is for prefix match with a command-body and
-- suffix match with an option, such as `!`.
-- The current implementation assumes only the `!` character
-- as the option delimiter.
-- See also #17345
isPrefixOptOf :: String -> String -> Bool
isPrefixOptOf :: [Char] -> [Char] -> Bool
isPrefixOptOf [Char]
s [Char]
x = let ([Char]
body, [Char]
opt) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') [Char]
s
                    in  ([Char]
body [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x) Bool -> Bool -> Bool
&& ([Char]
opt [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
x)

getCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan :: forall (m :: Type -> Type). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan = do
  [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
  case [Resume]
resumes of
    [] -> Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe SrcSpan
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> do
        let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
        if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
           then Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Resume -> SrcSpan
GHC.resumeSpan Resume
r))
           else do
                let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                SrcSpan
pan <- History -> m SrcSpan
forall (m :: Type -> Type). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan History
hist
                Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
pan)

getCallStackAtCurrentBreakpoint :: GHC.GhcMonad m => m (Maybe [String])
getCallStackAtCurrentBreakpoint :: forall (m :: Type -> Type). GhcMonad m => m (Maybe [[Char]])
getCallStackAtCurrentBreakpoint = do
  [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
  case [Resume]
resumes of
    [] -> Maybe [[Char]] -> m (Maybe [[Char]])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [[Char]]
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> do
       HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
       [[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]]) -> m [[Char]] -> m (Maybe [[Char]])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]] -> m [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> RemotePtr CostCentreStack -> IO [[Char]]
costCentreStackInfo HscEnv
hsc_env (Resume -> RemotePtr CostCentreStack
GHC.resumeCCS Resume
r))

getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
getCurrentBreakModule :: forall (m :: Type -> Type). GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
  [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
  case [Resume]
resumes of
    [] -> Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Module
forall a. Maybe a
Nothing
    (Resume
r:[Resume]
_) -> do
        let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
        if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
           then Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BreakInfo -> Module
GHC.breakInfo_module (BreakInfo -> Module) -> Maybe BreakInfo -> Maybe Module
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
`liftM` Resume -> Maybe BreakInfo
GHC.resumeBreakInfo Resume
r)
           else do
                let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Module -> m (Maybe Module))
-> Maybe Module -> m (Maybe Module)
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just (Module -> Maybe Module) -> Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ History -> Module
GHC.getHistoryModule  History
hist

-----------------------------------------------------------------------------
--
-- Commands
--
-----------------------------------------------------------------------------

noArgs :: MonadIO m => m () -> String -> m ()
noArgs :: forall (m :: Type -> Type). MonadIO m => m () -> [Char] -> m ()
noArgs m ()
m [Char]
"" = m ()
m
noArgs m ()
_ [Char]
_  = 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
$ [Char] -> IO ()
putStrLn [Char]
"This command takes no arguments"

withSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()
withSandboxOnly :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
cmd m ()
this = do
   DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
   if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciSandbox DynFlags
dflags)
      then SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
text [Char]
cmd SDoc -> SDoc -> SDoc
<+>
                         PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"is not supported with -fno-ghci-sandbox"))
      else m ()
this

-----------------------------------------------------------------------------
-- :help

help :: GhciMonad m => String -> m ()
help :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help [Char]
_ = do
    [Char]
txt <- GHCiState -> [Char]
long_help (GHCiState -> [Char]) -> m GHCiState -> m [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
    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
$ [Char] -> IO ()
putStr [Char]
txt

-----------------------------------------------------------------------------
-- :info

info :: GHC.GhcMonad m => Bool -> String -> m ()
info :: forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
_ [Char]
"" = GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: ':i <thing-you-want-info-about>'")
info Bool
allInfo [Char]
s  = (SourceError -> m ()) -> m () -> m ()
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> m ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
    [SDoc]
sdocs  <- ([Char] -> m SDoc) -> [[Char]] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> [Char] -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m SDoc
infoThing Bool
allInfo) ([Char] -> [[Char]]
words [Char]
s)
    (SDoc -> m ()) -> [SDoc] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SDoc -> IO ()) -> SDoc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (SDoc -> [Char]) -> SDoc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
unqual) [SDoc]
sdocs

infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
infoThing :: forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m SDoc
infoThing Bool
allInfo [Char]
str = do
    [Name]
names     <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
str
    [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs <- (Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
-> [Name]
-> m [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
forall (m :: Type -> Type).
GhcMonad m =>
Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
GHC.getInfo Bool
allInfo) [Name]
names
    let filtered :: [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered = ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> TyThing)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (\(TyThing
t,Fixity
_f,[ClsInst]
_ci,[FamInst]
_fi,SDoc
_sd) -> TyThing
t)
                                     ([Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs)
    SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> SDoc
text [Char]
"") ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprInfo [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered)

  -- Filter out names whose parent is also there Good
  -- example is '[]', which is both a type and data
  -- constructor in the same type
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren :: forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren a -> TyThing
get_thing [a]
xs
  = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filterOut a -> Bool
has_parent [a]
xs
  where
    all_names :: NameSet
all_names = [Name] -> NameSet
mkNameSet ((a -> Name) -> [a] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (TyThing -> Name
forall a. NamedThing a => a -> Name
getName (TyThing -> Name) -> (a -> TyThing) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TyThing
get_thing) [a]
xs)
    has_parent :: a -> Bool
has_parent a
x = case TyThing -> Maybe TyThing
tyThingParent_maybe (a -> TyThing
get_thing a
x) of
                     Just TyThing
p  -> TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
p Name -> NameSet -> Bool
`elemNameSet` NameSet
all_names
                     Maybe TyThing
Nothing -> Bool
False

pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
pprInfo :: (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprInfo (TyThing
thing, Fixity
fixity, [ClsInst]
cls_insts, [FamInst]
fam_insts, SDoc
docs)
  =  SDoc
docs
  SDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
pprTyThingInContextLoc TyThing
thing
  SDoc -> SDoc -> SDoc
$$ SDoc
show_fixity
  SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstance [ClsInst]
cls_insts)
  SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((FamInst -> SDoc) -> [FamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst  [FamInst]
fam_insts)
  where
    show_fixity :: SDoc
show_fixity
        | Fixity
fixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
GHC.defaultFixity = SDoc
empty
        | Bool
otherwise                   = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (TyThing -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyThing
thing)

-----------------------------------------------------------------------------
-- :main

runMain :: GhciMonad m => String -> m ()
runMain :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runMain [Char]
s = case [Char] -> Either [Char] [[Char]]
toArgs [Char]
s of
            Left [Char]
err   -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
            Right [[Char]]
args ->
                do DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
                   let main :: [Char]
main = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"main" (DynFlags -> Maybe [Char]
mainFunIs DynFlags
dflags)
                   -- Wrap the main function in 'void' to discard its value instead
                   -- of printing it (#9086). See Haskell 2010 report Chapter 5.
                   [[Char]] -> [Char] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[[Char]] -> [Char] -> m ()
doWithArgs [[Char]]
args ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Control.Monad.void (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
main [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-----------------------------------------------------------------------------
-- :run

runRun :: GhciMonad m => String -> m ()
runRun :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runRun [Char]
s = case [Char] -> Either [Char] ([Char], [[Char]])
toCmdArgs [Char]
s of
           Left [Char]
err          -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
           Right ([Char]
cmd, [[Char]]
args) -> [[Char]] -> [Char] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[[Char]] -> [Char] -> m ()
doWithArgs [[Char]]
args [Char]
cmd

doWithArgs :: GhciMonad m => [String] -> String -> m ()
doWithArgs :: forall (m :: Type -> Type).
GhciMonad m =>
[[Char]] -> [Char] -> m ()
doWithArgs [[Char]]
args [Char]
cmd = [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]
"System.Environment.withArgs " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                       [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
args [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"]

-----------------------------------------------------------------------------
-- :cd

changeDirectory :: GhciMonad m => String -> m ()
changeDirectory :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory [Char]
"" = do
  -- :cd on its own changes to the user's home directory
  Either IOException [Char]
either_dir <- IO (Either IOException [Char]) -> m (Either IOException [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char]) -> m (Either IOException [Char]))
-> IO (Either IOException [Char]) -> m (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO IO [Char]
getHomeDirectory
  case Either IOException [Char]
either_dir of
     Left IOException
_e -> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
     Right [Char]
dir -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory [Char]
dir
changeDirectory [Char]
dir = do
  ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([ModSummary] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([ModSummary] -> Bool) -> [ModSummary] -> Bool
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        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
$ [Char] -> IO ()
putStrLn [Char]
"Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
  -- delete targets and all eventually defined breakpoints (#1620)
  m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearAllTargets
  Bool -> [ModSummary] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [ModSummary] -> m ()
setContextAfterLoad Bool
False []
  m ()
forall (m :: Type -> Type). GhcMonad m => m ()
GHC.workingDirectoryChanged
  [Char]
dir' <- [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [Char]
dir
  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
$ [Char] -> IO ()
setCurrentDirectory [Char]
dir'
  -- With -fexternal-interpreter, we have to change the directory of the subprocess too.
  -- (this gives consistent behaviour with and without -fexternal-interpreter)
  HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
  case HscEnv -> Maybe Interp
hsc_interp HscEnv
hsc_env of
    Just (ExternalInterp {}) -> do
      ForeignHValue
fhv <- [Char] -> m ForeignHValue
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ForeignHValue
compileGHCiExpr ([Char] -> m ForeignHValue) -> [Char] -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$
        [Char]
"System.Directory.setCurrentDirectory " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
dir'
      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
    Maybe Interp
_ -> () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()