{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
module Clash.GHCi.UI (
interactiveUI,
GhciSettings(..),
defaultGhciSettings,
ghciCommands,
ghciWelcomeMsg,
makeHDL
) where
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
import GHC.Runtime.Interpreter
import GHCi.RemoteTypes
import GHCi.BreakArray( breakOn, breakOff )
import GHC.ByteCode.Types
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.PatSyn
import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Session as DynFlags
import GHC.Driver.Ppr hiding (printForUser)
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Monad ( modifySession )
import GHC.Driver.Make ( newIfaceCache, ModIfaceCache(..) )
import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Driver.Config.Diagnostic
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
getModuleGraph, handleSourceError, ms_mod )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
import GHC.Driver.Env
import GHC.Runtime.Context
import GHC.Types.TyThing
import GHC.Types.TyThing.Ppr
import GHC.Core.TyCo.Ppr
import GHC.Types.SafeHaskell ( getSafeMode )
import GHC.Types.SourceError ( SourceError )
import GHC.Types.Name
import GHC.Types.Var ( varType )
import GHC.Iface.Syntax ( showToHeader )
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.Parser.Header ( toArgs )
import qualified GHC.Parser.Header as Header
import GHC.Types.PkgQual
import GHC.Unit
import GHC.Unit.Finder as Finder
import GHC.Unit.Module.Graph (filterToposortToModules)
import GHC.Unit.Module.ModSummary
import GHC.Data.StringBuffer
import GHC.Utils.Outputable
import GHC.Utils.Logger
import GHC.Types.Basic hiding ( isTopLevel )
import GHC.Data.Graph.Directed
import GHC.Utils.Encoding
import GHC.Data.FastString
import qualified GHC.Linker.Loader as Loader
import GHC.Data.Maybe ( orElse, expectJust )
import GHC.Types.Name.Set
import GHC.Utils.Panic hiding ( showException, try )
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Bag (unitBag)
import qualified GHC.Data.Strict as Strict
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, intercalate, intersperse, minimumBy,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import Data.Maybe
import qualified Data.Map as M
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Time.LocalTime ( getZonedTime )
import Data.Time.Format ( formatTime, defaultTimeLocale )
import Data.Version ( showVersion )
import qualified Data.Semigroup as S
import Prelude hiding ((<>))
import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
import Foreign hiding (void)
import GHC.Stack hiding (SrcLoc(..))
import GHC.Unit.Env
import GHC.Unit.Home.ModInfo
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
import qualified GHC.Unit.Module.Graph as GHC
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 Data.Proxy
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 {
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 CmdExecOutcome,
CompletionFunc GHCi)
-> Command)
-> [([Char], [Char] -> InputT GHCi CmdExecOutcome,
CompletionFunc GHCi)]
-> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi CmdExecOutcome, CompletionFunc GHCi)
-> Command
mkCmd [
([Char]
"?", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
keepGoing [Char] -> GHCi ()
createCTagsWithLineNumbersCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"ctags!", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoing [Char] -> GHCi ()
createCTagsWithRegExesCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"def", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [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 CmdExecOutcome
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 CmdExecOutcome
keepGoing [Char] -> GHCi ()
createETagsFileCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"force", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
keepGoingMulti [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 CmdExecOutcome
keepGoingMulti [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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' (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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' (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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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]
"ignore", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
ignoreCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"kind", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad 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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad 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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type). Monad m => [Char] -> m CmdExecOutcome
quit, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"reload", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [Char] -> InputT GHCi ()
scriptCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"set", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoingMulti [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 CmdExecOutcome
keepGoingMulti [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] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [Char] -> InputT 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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeOfExpr, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"trace", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
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 CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
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 CmdExecOutcome) -> Command)
-> [([Char], [Char] -> InputT GHCi CmdExecOutcome)] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi CmdExecOutcome) -> Command
mkCmdHidden [
([Char]
"all-types", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
allTypesCmd),
([Char]
"complete", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoing [Char] -> GHCi ()
completeCmd),
([Char]
"loc-at", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
locAtCmd),
([Char]
"type-at", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeAtCmd),
([Char]
"uses", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
usesCmd)
]
where
mkCmd :: ([Char], [Char] -> InputT GHCi CmdExecOutcome, CompletionFunc GHCi)
-> Command
mkCmd ([Char]
n,[Char] -> InputT GHCi CmdExecOutcome
a,CompletionFunc GHCi
c) = Command { cmdName :: [Char]
cmdName = [Char]
n
, cmdAction :: [Char] -> InputT GHCi CmdExecOutcome
cmdAction = [Char] -> InputT GHCi CmdExecOutcome
a
, cmdHidden :: Bool
cmdHidden = Bool
False
, cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
c
}
mkCmdHidden :: ([Char], [Char] -> InputT GHCi CmdExecOutcome) -> Command
mkCmdHidden ([Char]
n,[Char] -> InputT GHCi CmdExecOutcome
a) = Command { cmdName :: [Char]
cmdName = [Char]
n
, cmdAction :: [Char] -> InputT GHCi CmdExecOutcome
cmdAction = [Char] -> InputT GHCi CmdExecOutcome
a
, cmdHidden :: Bool
cmdHidden = Bool
True
, cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion
}
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
word_break_chars_pred :: Char -> Bool
word_break_chars_pred :: Char -> Bool
word_break_chars_pred Char
'.' = Bool
False
word_break_chars_pred Char
c = Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` ([Char]
spaces [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specials) Bool -> Bool -> Bool
|| Char -> Bool
isSymbolChar Char
c
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"
showSDocForUser' :: GHC.GhcMonad m => SDoc -> m String
showSDocForUser' :: forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUser' SDoc
doc = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
UnitState
unit_state <- (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units (HscEnv -> UnitState) -> m HscEnv -> m UnitState
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
NamePprCtx
name_ppr_ctx <- m NamePprCtx
forall (m :: Type -> Type). GhcMonad m => m NamePprCtx
GHC.getNamePprCtx
[Char] -> m [Char]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ DynFlags -> UnitState -> NamePprCtx -> SDoc -> [Char]
showSDocForUser DynFlags
dflags UnitState
unit_state NamePprCtx
name_ppr_ctx SDoc
doc
showSDocForUserQualify :: GHC.GhcMonad m => SDoc -> m String
showSDocForUserQualify :: forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUserQualify SDoc
doc = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
UnitState
unit_state <- (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units (HscEnv -> UnitState) -> m HscEnv -> m UnitState
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[Char] -> m [Char]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Char] -> m [Char]) -> [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ DynFlags -> UnitState -> NamePprCtx -> SDoc -> [Char]
showSDocForUser DynFlags
dflags UnitState
unit_state NamePprCtx
alwaysQualify SDoc
doc
keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
keepGoing :: ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoing [Char] -> GHCi ()
a [Char]
str = ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' (GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> ([Char] -> GHCi ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GHCi ()
a) [Char]
str
keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
keepGoingMulti :: ([Char] -> GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
keepGoingMulti [Char] -> GHCi ()
a [Char]
str = ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' (GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> ([Char] -> GHCi ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GHCi ()
a) [Char]
str
keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m CmdExecOutcome
keepGoing' :: forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' a -> m ()
a a
str = do
Bool
in_multi <- m Bool
forall (m :: Type -> Type). GhciMonad m => m Bool
inMultiMode
if Bool
in_multi
then
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"Command is not supported (yet) in multi-mode"
else
a -> m ()
a a
str
CmdExecOutcome -> m CmdExecOutcome
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdSuccess
keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m CmdExecOutcome
keepGoingMulti' :: forall (m :: Type -> Type).
GhciMonad m =>
([Char] -> m ()) -> [Char] -> m CmdExecOutcome
keepGoingMulti' [Char] -> m ()
a [Char]
str = [Char] -> m ()
a [Char]
str m () -> m CmdExecOutcome -> m CmdExecOutcome
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> CmdExecOutcome -> m CmdExecOutcome
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdSuccess
inMultiMode :: GhciMonad m => m Bool
inMultiMode :: forall (m :: Type -> Type). GhciMonad m => m Bool
inMultiMode = GHCiState -> Bool
multiMode (GHCiState -> Bool) -> m GHCiState -> m Bool
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
keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi CmdExecOutcome)
keepGoingPaths :: ([[Char]] -> InputT GHCi ())
-> [Char] -> InputT GHCi CmdExecOutcome
keepGoingPaths [[Char]] -> InputT GHCi ()
a [Char]
str
= do case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
str of
Left [Char]
err -> IO CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall a. IO a -> InputT GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CmdExecOutcome -> InputT GHCi CmdExecOutcome)
-> IO CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err IO () -> IO CmdExecOutcome -> IO CmdExecOutcome
forall a b. IO a -> IO b -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> CmdExecOutcome -> IO CmdExecOutcome
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdSuccess
Right [[Char]]
args -> ([[Char]] -> InputT GHCi ())
-> [[Char]] -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [[Char]] -> InputT GHCi ()
a [[Char]]
args
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]
" :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 [<count>] resume after a breakpoint [and set break ignore count]\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]
" :ignore <breaknum> <count> for break <breaknum> set break ignore <count>\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.Environment.getArgs\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prog <progname> set the value returned by System.Environment.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]
"VISUAL" IO [Char] -> IO [Char] -> IO [Char]
forall a. IO a -> IO a -> IO a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> [Char] -> IO [Char]
getEnv [Char]
"EDITOR" IO [Char] -> IO [Char] -> IO [Char]
forall a. IO a -> IO a -> IO a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> IO [Char]
defaultEditor
where
defaultEditor :: IO [Char]
defaultEditor = do
#if defined(mingw32_HOST_OS)
win <- System.Win32.getWindowsDirectory
return (win </> "notepad.exe")
#else
[Char] -> IO [Char]
forall a. a -> IO a
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]
"clashi| "
default_args :: [String]
default_args :: [[Char]]
default_args = []
interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
-> Ghc ()
interactiveUI :: GhciSettings
-> [([Char], Maybe UnitId, Maybe Phase)]
-> Maybe [[Char]]
-> Ghc ()
interactiveUI GhciSettings
config [([Char], Maybe UnitId, Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs = do
(HscEnv -> HscEnv) -> Ghc ()
forall (m :: Type -> Type).
GhcMonad m =>
(HscEnv -> HscEnv) -> m ()
modifySession (\HscEnv
env -> (() :: Constraint) => UnitId -> HscEnv -> HscEnv
UnitId -> HscEnv -> HscEnv
hscSetActiveUnitId (HscEnv -> UnitId
hscActiveUnitId HscEnv
env) HscEnv
env)
StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a. IO a -> Ghc a
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 a. IO a -> Ghc a
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 a. IO a -> Ghc a
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
(ForeignHValue
nobuffering, ForeignHValue
flush) <- Ghc (ForeignHValue, ForeignHValue)
-> Ghc (ForeignHValue, ForeignHValue)
forall (m :: Type -> Type) a. GhcMonad m => m a -> m a
runInternal Ghc (ForeignHValue, ForeignHValue)
initInterpBuffering
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'
Bool
_ <- DynFlags -> Ghc Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags
(DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags GeneralFlag
Opt_KeepGoing)
IORef [(FastString, Int)]
lastErrLocationsRef <- IO (IORef [(FastString, Int)]) -> Ghc (IORef [(FastString, Int)])
forall a. IO a -> Ghc a
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 []
(LogAction -> LogAction) -> Ghc ()
forall (m :: Type -> Type).
GhcMonad m =>
(LogAction -> LogAction) -> m ()
pushLogHookM (IORef [(FastString, Int)] -> LogAction -> LogAction
ghciLogAction 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
ForeignHValue -> Ghc ()
forall (m :: Type -> Type). GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ ForeignHValue
nobuffering
IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
IO () -> Ghc ()
forall a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
#if defined(mingw32_HOST_OS)
liftIO $ hSetEncoding stdin utf8
#endif
[Char]
default_editor <- IO [Char] -> Ghc [Char]
forall a. IO a -> Ghc a
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 GhcPs
prelude_import = ModuleName -> ImportDecl GhcPs
simpleImportDecl ModuleName
preludeModuleName
HscEnv
hsc_env <- Ghc HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let in_multi :: Bool
in_multi = Set UnitId -> Int
forall a. Set a -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
ModIfaceCache
empty_cache <- IO ModIfaceCache -> Ghc ModIfaceCache
forall a. IO a -> Ghc a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO ModIfaceCache
newIfaceCache
GHCi () -> GHCiState -> Ghc ()
forall a. GHCi a -> GHCiState -> Ghc a
startGHCi ([([Char], Maybe UnitId, Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe UnitId, Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs)
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 = [],
multiMode :: Bool
multiMode = Bool
in_multi,
localConfig :: LocalConfigBehaviour
localConfig = LocalConfigBehaviour
SourceLocalConfig,
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
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,
ifaceCache :: ModIfaceCache
ifaceCache = ModIfaceCache
empty_cache
}
() -> Ghc ()
forall a. a -> Ghc a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [(FastString, Int)] -> [(FastString, Int)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GHCiState -> IORef [(FastString, Int)]
lastErrorLocations GHCiState
st) []
ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
ghciLogAction IORef [(FastString, Int)]
lastErrLocations LogAction
old_log_action
LogFlags
dflags MessageClass
msg_class SrcSpan
srcSpan SDoc
msg = do
LogAction
old_log_action LogFlags
dflags MessageClass
msg_class SrcSpan
srcSpan SDoc
msg
case MessageClass
msg_class of
MCDiagnostic Severity
SevError DiagnosticReason
_reason Maybe DiagnosticCode
_code -> 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 a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
MessageClass
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
getAppDataFile :: FilePath -> IO (Maybe FilePath)
getAppDataFile :: [Char] -> IO (Maybe [Char])
getAppDataFile [Char]
file = do
let new_path :: IO (Maybe [Char])
new_path = IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO (XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"clash") IO (Either IOException [Char])
-> (Either IOException [Char] -> IO (Maybe [Char]))
-> IO (Maybe [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left IOException
_ -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
Right [Char]
dir -> (IO (Maybe [Char])
-> (IOException -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (IOException -> IO (Maybe [Char]))
-> IO (Maybe [Char])
-> IO (Maybe [Char])
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO (Maybe [Char])
-> (IOException -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (IO (Maybe [Char]) -> IOException -> IO (Maybe [Char])
forall a b. a -> b -> a
const (IO (Maybe [Char]) -> IOException -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IOException -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing) (IO (Maybe [Char]) -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
dir
Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
file
Either IOException [Char]
e_old_path <- 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]
e_old_path of
Right [Char]
old_path -> [Char] -> IO Bool
doesDirectoryExist [Char]
old_path IO Bool -> (Bool -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
old_path [Char] -> [Char] -> [Char]
</> [Char]
file
Bool
False -> IO (Maybe [Char])
new_path
Left IOException
_ -> IO (Maybe [Char])
new_path
runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi :: [([Char], Maybe UnitId, Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe UnitId, 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 a. IO a -> GHCi a
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])
getAppDataFile [Char]
"clashi.conf"
home_dir :: GHCi (Maybe [Char])
home_dir = do
Either IOException [Char]
either_dir <- IO (Either IOException [Char]) -> GHCi (Either IOException [Char])
forall a. IO a -> GHCi a
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 a. a -> GHCi a
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 a. a -> GHCi a
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 a. a -> IO a
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 a. IO a -> GHCi a
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 a. IO a -> GHCi a
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 a. a -> GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
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 a. IO a -> GHCi a
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 a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
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 a. IO a -> GHCi a
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 a. a -> GHCi a
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)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence [ GHCi (Maybe [Char])
app_user_dir, GHCi (Maybe [Char])
home_dir ]
[[Char]]
checkedPaths <- IO [[Char]] -> GHCi [[Char]]
forall a. IO a -> GHCi a
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 a. IO a -> GHCi a
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 a b. (a -> b) -> IO a -> IO b
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)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [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 a. IO a -> GHCi a
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 a. IO a -> GHCi a
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 a. a -> GHCi a
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
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 ->
case LocalConfigBehaviour
behaviour of
LocalConfigBehaviour
SourceLocalConfig -> Maybe [Char]
localCfg Maybe [Char] -> GHCi () -> GHCi (Maybe [Char])
forall a b. a -> GHCi b -> GHCi a
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 a. a -> GHCi a
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 a. a -> GHCi a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
[[Char]] -> GHCi [[Char]]
forall a. a -> GHCi a
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
([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
Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([([Char], Maybe UnitId, Maybe Phase)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [([Char], Maybe UnitId, 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.
(HasLogger 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 a. a -> GHCi a
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
$
[([Char], Maybe UnitId, Maybe Phase)] -> GHCi SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule [([Char], Maybe UnitId, 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 a. IO a -> GHCi a
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).
GhciMonad 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)
Bool
is_tty <- IO Bool -> GHCi Bool
forall a. IO a -> GHCi a
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
(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=0}
case Maybe [[Char]]
maybe_exprs of
Maybe [[Char]]
Nothing ->
do
[[Char]] -> GHCi ()
runGHCiExpressions
[[Char]
"default ((), [], Prelude.Integer, Prelude.Int, Prelude.Double, Prelude.String)"]
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
[[Char]] -> GHCi ()
runGHCiExpressions [[Char]]
exprs
IO () -> GHCi ()
forall a. IO a -> GHCi a
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
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
IO b -> m b
forall a. IO a -> m a
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
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
()
_ <- (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 a b. GHCi a -> GHCi b -> GHCi b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> GHCi ()
forall a. a -> GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
(Maybe [Char] -> InputT GHCi (Maybe [Char])
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
() -> InputT GHCi ()
forall a. a -> InputT GHCi a
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 a. IO a -> GHCi a
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 a. a -> GHCi a
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]
".clashi_history"))
(Bool
True, Bool
_) -> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a. IO a -> GHCi a
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])
getAppDataFile [Char]
"clashi_history"
(Bool, Bool)
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall a. a -> GHCi a
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 = histFile})
InputT GHCi a
f
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 (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt else [Char] -> InputT GHCi [Char]
forall a. a -> InputT GHCi a
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 a. a -> InputT GHCi a
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 (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt InputT GHCi [Char] -> ([Char] -> InputT GHCi ()) -> InputT GHCi ()
forall a b. InputT GHCi a -> (a -> InputT GHCi b) -> InputT GHCi b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> InputT GHCi ()
forall a. IO a -> InputT GHCi a
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
checkFileAndDirPerms :: FilePath -> IO Bool
checkFileAndDirPerms :: [Char] -> IO Bool
checkFileAndDirPerms [Char]
file = do
Bool
file_ok <- [Char] -> IO Bool
checkPerms [Char]
file
if Bool
file_ok then [Char] -> IO Bool
checkPerms ([Char] -> [Char]
getDirectory [Char]
file) else Bool -> IO Bool
forall a. a -> IO a
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 a. a -> IO a
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
$
[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 a. a -> IO a
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 = line_number st + 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 a. IO a -> m a
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
|
IOException -> Bool
isIllegalOperation IOException
e -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
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 a. a -> m a
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 a. IO a -> m a
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
Right [Char]
l' -> do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo
Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall a. a -> IO a
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
forall doc. IsOutput doc => doc
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Resume -> SrcSpan
GHC.resumeSpan Resume
r)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
space)
else do
let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. HasCallStack => [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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> Int
forall a. Num a => a -> a
negate Int
ix) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':'
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
space)
let
dots :: SDoc
dots | Resume
_:[Resume]
rs <- [Resume]
resumes, Bool -> Bool
not ([Resume] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Resume]
rs) = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"... "
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
rev_imports :: [InteractiveImport]
rev_imports = [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a]
reverse [InteractiveImport]
imports
myIdeclName :: ImportDecl pass -> ModuleName
myIdeclName ImportDecl pass
d | Just XRec pass ModuleName
m <- ImportDecl pass -> Maybe (XRec pass ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl pass
d = GenLocated l ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc XRec pass ModuleName
GenLocated l ModuleName
m
| Bool
otherwise = GenLocated l ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl pass -> XRec pass ModuleName
forall pass. ImportDecl pass -> XRec pass 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} {l}.
(XRec pass ModuleName ~ GenLocated l ModuleName) =>
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc
dots SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
context_bit, [[Char]]
modules_names, Int
line)
parseCallEscape :: String -> Maybe (NE.NonEmpty String, String)
parseCallEscape :: [Char] -> Maybe (NonEmpty [Char], [Char])
parseCallEscape [Char]
s = case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
s of
Char
'(' : [Char]
sinceOpen -> case (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]
sinceOpen of
([Char]
call, Char
')' : [Char]
sinceClosed)
| [Char]
cmd : [[Char]]
args <- [Char] -> [[Char]]
words [Char]
call -> (NonEmpty [Char], [Char]) -> Maybe (NonEmpty [Char], [Char])
forall a. a -> Maybe a
Just ([Char]
cmd [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
NE.:| [[Char]]
args, [Char]
sinceClosed)
([Char], [Char])
_ -> Maybe (NonEmpty [Char], [Char])
forall a. Maybe a
Nothing
[Char]
_ -> Maybe (NonEmpty [Char], [Char])
forall a. Maybe a
Nothing
checkPromptStringForErrors :: String -> Maybe String
checkPromptStringForErrors :: [Char] -> Maybe [Char]
checkPromptStringForErrors (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) =
case [Char] -> Maybe (NonEmpty [Char], [Char])
parseCallEscape [Char]
xs of
Maybe (NonEmpty [Char], [Char])
Nothing -> [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).")
Just (NonEmpty [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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (SDoc -> GHCi SDoc
forall a. a -> GHCi a
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
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> ([[Char]] -> [SDoc]) -> [[Char]] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([[Char]] -> [SDoc])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
ordNub ([[Char]] -> SDoc) -> [[Char]] -> SDoc
forall a b. (a -> b) -> a -> b
$ [[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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (SDoc -> GHCi SDoc
forall a. a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
user_name) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
user_name :: GHCi [Char]
user_name = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => doc -> doc -> doc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text GHCi [Char]
current_directory) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
current_directory :: GHCi [Char]
current_directory = IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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
forall doc. IsLine doc => [Char] -> doc
text [Char]
os) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([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
forall doc. IsLine doc => [Char] -> doc
text [Char]
arch) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([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
forall doc. IsLine doc => [Char] -> doc
text [Char]
compilerName) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([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
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
showVersion Version
compilerVersion) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) = do
let ([Char]
cmd NE.:| [[Char]]
args, [Char]
afterClosed) = Maybe (NonEmpty [Char], [Char]) -> (NonEmpty [Char], [Char])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (NonEmpty [Char], [Char]) -> (NonEmpty [Char], [Char]))
-> Maybe (NonEmpty [Char], [Char]) -> (NonEmpty [Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe (NonEmpty [Char], [Char])
parseCallEscape [Char]
xs
[Char]
respond <- IO [Char] -> GHCi [Char]
forall a. IO a -> GHCi a
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]
cmd [[Char]]
args [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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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
forall doc. IsLine doc => [Char] -> doc
text [Char]
respond) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([Char] -> GHCi SDoc
processString [Char]
afterClosed)
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
forall doc. IsLine doc => Char -> doc
char Char
'%') SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([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
forall doc. IsLine doc => Char -> doc
char Char
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString [Char]
"" =
SDoc -> GHCi SDoc
forall a. a -> GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
forall doc. IsOutput doc => doc
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
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
prompt_string
[Char] -> GHCi [Char]
forall a. a -> GHCi a
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 a. a -> m a
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 = cs }
Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c)
installInteractivePrint :: GhciMonad m => Maybe String -> Bool -> m ()
installInteractivePrint :: forall (m :: Type -> Type).
GhciMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint Maybe [Char]
Nothing Bool
_ = () -> m ()
forall a. a -> m a
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).
GhciMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ do
Name
name NE.:| [Name]
_ <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
ipFun
(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 = new_ic})
SuccessFlag -> m SuccessFlag
forall a. a -> m a
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 a. IO a -> m a
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))
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 a b. InputT GHCi a -> InputT GHCi b -> InputT GHCi b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> InputT GHCi ()
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
runCommands' :: (SomeException -> GHCi Bool)
-> Maybe (GHCi ())
-> 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 b.
HasCallStack =>
((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi b)
-> InputT GHCi b
forall (m :: Type -> Type) b.
(MonadMask m, HasCallStack) =>
((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.
(HasCallStack, 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 a. a -> InputT GHCi a
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 a. IO a -> InputT GHCi a
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 a. a -> InputT GHCi a
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 a. IO a -> InputT GHCi a
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 a. a -> InputT GHCi a
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 a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
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
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 (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi (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 a. a -> InputT GHCi a
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 a. a -> InputT GHCi a
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.
(HasLogger m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
e -> GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (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 a b. GHCi a -> (a -> GHCi b) -> GHCi b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Bool -> GHCi (Maybe Bool)
forall a. a -> GHCi a
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}.
(HasLogger m, MonadIO m, HasDynFlags 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
where
printErrorAndFail :: SourceError -> m (Maybe Bool)
printErrorAndFail SourceError
err = do
SourceError -> m ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException SourceError
err
Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
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 a b. m a -> (a -> m b) -> m b
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 a. a -> m a
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 a. a -> m a
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 = prompt_cont 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.
(HasCallStack, 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 = p })
Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
mb_cmd
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 a b. m a -> (a -> m b) -> m b
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 a. IO a -> m a
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 a. a -> m a
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
collectError :: IOException
collectError = [Char] -> IOException
userError [Char]
"unterminated multiline command :{ .. :}"
cmdOutcome :: CmdExecOutcome -> Maybe Bool
cmdOutcome :: CmdExecOutcome -> Maybe Bool
cmdOutcome CmdExecOutcome
CleanExit = Maybe Bool
forall a. Maybe a
Nothing
cmdOutcome CmdExecOutcome
CmdSuccess = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
cmdOutcome CmdExecOutcome
CmdFailure = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
doCommand :: String -> InputT GHCi CommandResult
doCommand :: [Char] -> InputT GHCi CommandResult
doCommand [Char]
stmt | stmt' :: [Char]
stmt'@(Char
':' : [Char]
cmd) <- [Char] -> [Char]
removeSpaces [Char]
stmt = do
(ActionStats
stats, Either SomeException CmdExecOutcome
result) <- (CmdExecOutcome -> Maybe Integer)
-> InputT GHCi CmdExecOutcome
-> InputT GHCi (ActionStats, Either SomeException CmdExecOutcome)
forall (m :: Type -> Type) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats (Maybe Integer -> CmdExecOutcome -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) (InputT GHCi CmdExecOutcome
-> InputT GHCi (ActionStats, Either SomeException CmdExecOutcome))
-> InputT GHCi CmdExecOutcome
-> InputT GHCi (ActionStats, Either SomeException CmdExecOutcome)
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT GHCi CmdExecOutcome
specialCommand [Char]
cmd
CommandResult -> InputT GHCi CommandResult
forall a. a -> InputT GHCi a
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' (CmdExecOutcome -> Maybe Bool
cmdOutcome (CmdExecOutcome -> Maybe Bool)
-> Either SomeException CmdExecOutcome
-> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException CmdExecOutcome
result) ActionStats
stats
doCommand [Char]
stmt = do
let stmt_nl_cnt :: Int
stmt_nl_cnt = [()] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ () | Char
'\n' <- [Char]
stmt ]
Bool
ml <- GHCi Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi 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
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 a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CommandResult
CommandIncomplete
Just [Char]
ml_stmt -> do
(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 (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (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 a. a -> InputT GHCi a
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
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
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
stmt_nl_cnt2 :: Int
stmt_nl_cnt2 = [()] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ () | Char
'\n' <- [Char]
stmt' ]
stmt' :: [Char]
stmt' = [Char] -> [Char]
dropLeadingWhiteLines [Char]
stmt
(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 (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (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 a. a -> InputT GHCi a
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
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 = 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
GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState GHCi GHCiState -> (GHCiState -> GHCi ()) -> GHCi ()
forall a b. GHCi a -> (a -> GHCi b) -> GHCi b
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 = line_number st0 }
Maybe ExecResult -> GHCi (Maybe ExecResult)
forall a. a -> GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
result
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
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 = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
Lexer.initParserState (DynFlags -> ParserOpts
initParserOpts 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 a. a -> m a
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 = prompt_cont st1 }
Maybe [Char]
mb_stmt <- (SomeException -> m (Maybe [Char]))
-> m (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a.
(HasLogger 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 a. a -> m a
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 a. IO a -> m a
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 a. a -> m a
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 a. IO a -> m a
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 = p })
case Maybe [Char]
mb_stmt of
Maybe [Char]
Nothing -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
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 a. a -> m a
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 a. a -> P a
forall (m :: Type -> Type) a. Monad m => a -> m a
return P (Located Token) -> P Bool -> P Bool
forall a b. P a -> P b -> P b
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
[[Char]]
cmds [[Char]] -> m () -> m ()
forall a b. NFData a => a -> b -> b
`deepseq` () -> m ()
forall a. a -> m a
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 = cmds ++ cmdqueue st }
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
ParserOpts
pflags <- DynFlags -> ParserOpts
initParserOpts (DynFlags -> ParserOpts) -> m DynFlags -> m ParserOpts
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
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
ParserOpts -> m ()
set_pragmas ParserOpts
pflags
if | ParserOpts -> [Char] -> Bool
GHC.isStmt ParserOpts
pflags [Char]
input -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
mb_stmt <- IO
(Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> m (Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv
-> Hsc
(Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> IO
(Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
mb_stmt of
Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
Nothing ->
Maybe ExecResult -> m (Maybe ExecResult)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just ExecResult
exec_complete)
Just GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
stmt ->
GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt GhciLStmt GhcPs
GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
stmt
| Bool
otherwise -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let !ic :: InteractiveContext
ic = HscEnv -> InteractiveContext
hsc_IC HscEnv
hsc_env
InteractiveContext -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
InteractiveContext -> m ()
setDumpFilePrefix InteractiveContext
ic
IO (HsModule GhcPs) -> m (HsModule GhcPs)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> [Char] -> Int -> [Char] -> IO (HsModule GhcPs)
hscParseModuleWithLocation HscEnv
hsc_env [Char]
source Int
line [Char]
input) m (HsModule GhcPs)
-> (HsModule GhcPs -> m (Maybe ExecResult)) -> m (Maybe ExecResult)
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HsModule { hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls = [LHsDecl GhcPs]
decls, hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports = [LImportDecl GhcPs]
imports } -> do
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> m ()
forall {t :: Type -> Type} {m :: Type -> Type} {l}.
(Foldable t, GhciMonad m) =>
t (GenLocated l (ImportDecl GhcPs)) -> m ()
run_imports [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
[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_imports :: t (GenLocated l (ImportDecl GhcPs)) -> m ()
run_imports t (GenLocated l (ImportDecl GhcPs))
imports = (GenLocated l (ImportDecl GhcPs) -> m ())
-> t (GenLocated l (ImportDecl GhcPs)) -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ImportDecl GhcPs -> m ()
forall (m :: Type -> Type). GhciMonad m => ImportDecl GhcPs -> m ()
addImportToContext (ImportDecl GhcPs -> m ())
-> (GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated l (ImportDecl GhcPs)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc) t (GenLocated l (ImportDecl GhcPs))
imports
set_pragmas :: ParserOpts -> m ()
set_pragmas ParserOpts
pflags =
let stringbuf :: StringBuffer
stringbuf = [Char] -> StringBuffer
stringToStringBuffer [Char]
input
(Messages PsMessage
_msgs, [Located [Char]]
loc_opts) = ParserOpts
-> StringBuffer -> [Char] -> (Messages PsMessage, [Located [Char]])
Header.getOptions ParserOpts
pflags StringBuffer
stringbuf [Char]
"<interactive>"
opts :: [[Char]]
opts = Located [Char] -> [Char]
forall l e. GenLocated l e -> e
unLoc (Located [Char] -> [Char]) -> [Located [Char]] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located [Char]]
loc_opts
in [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setOptions [[Char]]
opts
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 a. a -> m a
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
run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult)
run_decls :: forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe ExecResult)
run_decls [L SrcSpanAnnA
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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsBind GhcPs
bind)
run_decls [L SrcSpanAnnA
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 (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsBind GhcPs
bind)
run_decls [LHsDecl GhcPs]
decls = do
Either IOException ()
_ <- IO (Either IOException ()) -> m (Either IOException ())
forall a. IO a -> m a
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
la :: StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
la = SrcSpanAnnA
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
la' :: HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
la' = SrcSpanAnnA
-> HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc)
in StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
la (XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBindsLR GhcPs GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (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
EpAnn AnnList
forall a. EpAnn a
noAnn (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
AnnSortKey
NoAnnSortKey (GenLocated SrcSpanAnnA (HsBind GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
forall a. a -> Bag a
unitBag (HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
la' HsBind GhcPs
bind)) [])))
setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m ()
setDumpFilePrefix :: forall (m :: Type -> Type).
GhcMonad m =>
InteractiveContext -> m ()
setDumpFilePrefix InteractiveContext
ic = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
DynFlags -> m ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setInteractiveDynFlags DynFlags
dflags { dumpPrefix = modStr ++ "." }
where
modStr :: [Char]
modStr = ModuleName -> [Char]
moduleNameString (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ InteractiveContext -> GenModule Unit
icInteractiveModule (InteractiveContext -> GenModule Unit)
-> InteractiveContext -> GenModule Unit
forall a b. (a -> b) -> a -> b
$ InteractiveContext
ic
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]
execResult :: Either SomeException [Name]
execAllocation :: Word64
execResult :: ExecResult -> Either SomeException [Name]
execAllocation :: ExecResult -> Word64
..} ->
case Either SomeException [Name]
execResult of
Left SomeException
ex -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
| Resume
first_resume : [Resume]
_ <- [Resume]
resumes
, 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
first_resume) -> 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 a. [a] -> 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
first_resume [Name]
names
else [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]
bCmd]
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
| Bool
otherwise -> (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
resume SrcSpan -> Bool
step_here SingleStep
GHC.SingleStep Maybe Int
forall a. Maybe a
Nothing m ExecResult -> (ExecResult -> m ExecResult) -> m ExecResult
forall a b. m a -> (a -> m b) -> m b
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 a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
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 a. a -> m a
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]
execResult :: ExecResult -> Either SomeException [Name]
execAllocation :: ExecResult -> Word64
execResult :: Either SomeException [Name]
execAllocation :: Word64
..} -> 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 a. a -> m a
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 :: GenModule Unit
md = BreakInfo -> GenModule Unit
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 a. a -> m a
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 -> GenModule Unit
breakModule BreakLocation
loc GenModule Unit -> GenModule Unit -> Bool
forall a. Eq a => a -> a -> Bool
== GenModule Unit
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
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)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [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)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [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
forall doc. IsDoc doc => [doc] -> doc
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
compareNames :: Name -> Name -> Ordering
compareNames = ([Char] -> [Char] -> Ordering)
-> (Name -> [Char]) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Name -> [Char]
forall a. NamedThing a => a -> [Char]
getOccString (Name -> Name -> Ordering)
-> (Name -> Name -> Ordering) -> Name -> Name -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan
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 a. a -> m a
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
specialCommand :: String -> InputT GHCi CmdExecOutcome
specialCommand :: [Char] -> InputT GHCi CmdExecOutcome
specialCommand (Char
'!':[Char]
str) = GHCi CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi CmdExecOutcome -> InputT GHCi CmdExecOutcome)
-> GHCi CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall a b. (a -> b) -> a -> b
$ [Char] -> GHCi CmdExecOutcome
forall (m :: Type -> Type). MonadIO m => [Char] -> m CmdExecOutcome
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 CmdExecOutcome
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 a. IO a -> InputT GHCi a
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
stderr ([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)
CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdFailure
MaybeCommand
NoLastCommand ->
do IO () -> InputT GHCi ()
forall a. IO a -> InputT GHCi a
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
stderr ([Char]
"there is no last command to perform\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
htxt)
CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdFailure
shellEscape :: MonadIO m => String -> m CmdExecOutcome
shellEscape :: forall (m :: Type -> Type). MonadIO m => [Char] -> m CmdExecOutcome
shellEscape [Char]
str = IO CmdExecOutcome -> m CmdExecOutcome
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CmdExecOutcome -> m CmdExecOutcome)
-> IO CmdExecOutcome -> m CmdExecOutcome
forall a b. (a -> b) -> a -> b
$ do
ExitCode
exitCode <- [Char] -> IO ExitCode
system [Char]
str
case ExitCode
exitCode of
ExitCode
ExitSuccess -> CmdExecOutcome -> IO CmdExecOutcome
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdSuccess
ExitFailure Int
_ -> CmdExecOutcome -> IO CmdExecOutcome
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdFailure
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 a. a -> m a
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 a. a -> m a
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 = mc })
MaybeCommand -> m MaybeCommand
forall a. a -> m a
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 a. a -> m a
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, [])
[Char]
_ -> ([Char]
str', [Command]
macros)
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
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
Maybe Command -> m (Maybe Command)
forall a. a -> m a
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
(Maybe Command
builtinPfxMatch Maybe Command -> (Command -> Maybe Command) -> Maybe Command
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
Maybe Command
builtinPfxMatch Maybe Command -> Maybe Command -> Maybe Command
forall a. Maybe a -> Maybe a -> Maybe a
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
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 a. a -> m a
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 a. a -> m a
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. HasCallStack => [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 a. a -> m a
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 a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [[Char]]
forall a. Maybe a
Nothing
(Resume
r:[Resume]
_) -> do
Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[[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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Interp -> RemotePtr CostCentreStack -> IO [[Char]]
costCentreStackInfo Interp
interp (Resume -> RemotePtr CostCentreStack
GHC.resumeCCS Resume
r))
getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
getCurrentBreakModule :: forall (m :: Type -> Type).
GhcMonad m =>
m (Maybe (GenModule Unit))
getCurrentBreakModule = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (GenModule Unit)
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 (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BreakInfo -> GenModule Unit
GHC.breakInfo_module (BreakInfo -> GenModule Unit)
-> Maybe BreakInfo -> Maybe (GenModule Unit)
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. HasCallStack => [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (GenModule Unit) -> m (Maybe (GenModule Unit)))
-> Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> Maybe (GenModule Unit)
forall a. a -> Maybe a
Just (GenModule Unit -> Maybe (GenModule Unit))
-> GenModule Unit -> Maybe (GenModule Unit)
forall a b. (a -> b) -> a -> b
$ History -> GenModule Unit
GHC.getHistoryModule History
hist
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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [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
forall doc. IsLine doc => [Char] -> doc
text [Char]
cmd SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not supported with -fno-ghci-sandbox")
else m ()
this
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 a b. (a -> b) -> m a -> m b
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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
txt
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).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[[Char]] -> ([Char] -> m ()) -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Char] -> [[Char]]
words [Char]
s) (([Char] -> m ()) -> m ()) -> ([Char] -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \[Char]
thing -> do
SDoc
sdoc <- Bool -> [Char] -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m SDoc
infoThing Bool
allInfo [Char]
thing
[Char]
rendered <- SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUser' SDoc
sdoc
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn [Char]
rendered)
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
NonEmpty Name
names <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
str
NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
mb_stuffs <- (Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
-> NonEmpty Name
-> m (NonEmpty
(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)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty 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) NonEmpty 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 (NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
-> [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
mb_stuffs))
SDoc -> m SDoc
forall a. a -> m a
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
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
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)
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
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> SDoc
pprTyThingInContextLoc TyThing
thing
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstance [ClsInst]
cls_insts)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FamInst -> SDoc) -> [FamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst [FamInst]
fam_insts)
runMain :: GhciMonad m => String -> m ()
runMain :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runMain [Char]
s = case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
s of
Left [Char]
err -> IO () -> m ()
forall a. IO a -> m a
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)
[[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]
")"
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 a. IO a -> m a
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]
")"]
getCmd :: String -> Either String
(String, String)
getCmd :: [Char] -> Either [Char] ([Char], [Char])
getCmd [Char]
s = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
s of
([], [Char]
_) -> [Char] -> Either [Char] ([Char], [Char])
forall a b. a -> Either a b
Left ([Char]
"Couldn't find command in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s)
([Char], [Char])
res -> ([Char], [Char]) -> Either [Char] ([Char], [Char])
forall a b. b -> Either a b
Right ([Char], [Char])
res
toCmdArgs :: String -> Either String
(String, [String])
toCmdArgs :: [Char] -> Either [Char] ([Char], [[Char]])
toCmdArgs [Char]
s = case [Char] -> Either [Char] ([Char], [Char])
getCmd [Char]
s of
Left [Char]
err -> [Char] -> Either [Char] ([Char], [[Char]])
forall a b. a -> Either a b
Left [Char]
err
Right ([Char]
cmd, [Char]
s') -> case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
s' of
Left [Char]
err -> [Char] -> Either [Char] ([Char], [[Char]])
forall a b. a -> Either a b
Left [Char]
err
Right [[Char]]
args -> ([Char], [[Char]]) -> Either [Char] ([Char], [[Char]])
forall a b. b -> Either a b
Right ([Char]
cmd, [[Char]]
args)
toArgsNoLoc :: String -> Either String [String]
toArgsNoLoc :: [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
str = (Located [Char] -> [Char]) -> [Located [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Located [Char] -> [Char]
forall l e. GenLocated l e -> e
unLoc ([Located [Char]] -> [[Char]])
-> Either [Char] [Located [Char]] -> Either [Char] [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> RealSrcLoc -> [Char] -> Either [Char] [Located [Char]]
toArgs RealSrcLoc
fake_loc [Char]
str
where
fake_loc :: RealSrcLoc
fake_loc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc ([Char] -> FastString
fsLit [Char]
"<interactive>") Int
1 Int
1
changeDirectory :: GhciMonad m => String -> m ()
changeDirectory :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory [Char]
"" = do
Either IOException [Char]
either_dir <- IO (Either IOException [Char]) -> m (Either IOException [Char])
forall a. IO a -> m a
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 a. a -> m a
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 a. [a] -> 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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearCaches
Bool -> Maybe ModuleGraph -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> Maybe ModuleGraph -> m ()
setContextAfterLoad Bool
False Maybe ModuleGraph
forall a. Maybe a
Nothing
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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
setCurrentDirectory [Char]
dir'
Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
case Interp -> InterpInstance
interpInstance Interp
interp of
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 a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> ForeignHValue -> IO ()
evalIO Interp
interp ForeignHValue
fhv
InterpInstance
_ -> () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
trySuccess :: GhciMonad m => m SuccessFlag -> m SuccessFlag
trySuccess :: forall (m :: Type -> Type).
GhciMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess m SuccessFlag
act =
(SourceError -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (\SourceError
e -> do SourceError -> m ()
forall (m :: Type -> Type).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit SourceError
e
SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Failed) (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ do
m SuccessFlag
act
editFile :: GhciMonad m => String -> m ()
editFile :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
editFile [Char]
str =
do [Char]
file <- if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
str then m [Char]
forall (m :: Type -> Type). GhcMonad m => m [Char]
chooseEditFile else [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [Char]
str
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
[(FastString, Int)]
errs <- IO [(FastString, Int)] -> m [(FastString, Int)]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [(FastString, Int)] -> m [(FastString, Int)])
-> IO [(FastString, Int)] -> m [(FastString, Int)]
forall a b. (a -> b) -> a -> b
$ IORef [(FastString, Int)] -> IO [(FastString, Int)]
forall a. IORef a -> IO a
readIORef (IORef [(FastString, Int)] -> IO [(FastString, Int)])
-> IORef [(FastString, Int)] -> IO [(FastString, Int)]
forall a b. (a -> b) -> a -> b
$ GHCiState -> IORef [(FastString, Int)]
lastErrorLocations GHCiState
st
let cmd :: [Char]
cmd = GHCiState -> [Char]
editor GHCiState
st
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
cmd)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"editor not set, use :set editor")
[Char]
lineOpt <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
let sameFile :: [Char] -> [Char] -> IO Bool
sameFile [Char]
p1 [Char]
p2 = ([Char] -> [Char] -> Bool) -> IO [Char] -> IO [Char] -> IO Bool
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> IO [Char]
canonicalizePath [Char]
p1) ([Char] -> IO [Char]
canonicalizePath [Char]
p2)
IO Bool -> (IOException -> IO Bool) -> IO Bool
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False)
[(FastString, Int)]
curFileErrs <- ((FastString, Int) -> IO Bool)
-> [(FastString, Int)] -> IO [(FastString, Int)]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\(FastString
f, Int
_) -> FastString -> [Char]
unpackFS FastString
f [Char] -> [Char] -> IO Bool
`sameFile` [Char]
file) [(FastString, Int)]
errs
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ case [(FastString, Int)]
curFileErrs of
(FastString
_, Int
line):[(FastString, Int)]
_ -> [Char]
" +" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
line
[(FastString, Int)]
_ -> [Char]
""
let cmdArgs :: [Char]
cmdArgs = Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:([Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lineOpt)
ExitCode
code <- IO ExitCode -> m ExitCode
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> m ExitCode) -> IO ExitCode -> m ExitCode
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ExitCode
system ([Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmdArgs)
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule [Char]
""
chooseEditFile :: GHC.GhcMonad m => m String
chooseEditFile :: forall (m :: Type -> Type). GhcMonad m => m [Char]
chooseEditFile =
do let hasFailed :: ModuleGraphNode -> f Bool
hasFailed (GHC.ModuleNode [NodeKey]
_deps ModSummary
x) = (Bool -> Bool) -> f Bool -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (f Bool -> f Bool) -> f Bool -> f Bool
forall a b. (a -> b) -> a -> b
$ ModSummary -> f Bool
forall (m :: Type -> Type). GhcMonad m => ModSummary -> m Bool
isLoadedModSummary ModSummary
x
hasFailed ModuleGraphNode
_ = Bool -> f Bool
forall a. a -> f a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
ModuleGraph
failed_graph <-
[ModuleGraphNode] -> ModuleGraph
GHC.mkModuleGraph ([ModuleGraphNode] -> ModuleGraph)
-> m [ModuleGraphNode] -> m ModuleGraph
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleGraphNode -> m Bool)
-> [ModuleGraphNode] -> m [ModuleGraphNode]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModuleGraphNode -> m Bool
forall {f :: Type -> Type}. GhcMonad f => ModuleGraphNode -> f Bool
hasFailed (ModuleGraph -> [ModuleGraphNode]
GHC.mgModSummaries' ModuleGraph
graph)
let order :: ModuleGraph -> [ModSummary]
order ModuleGraph
g = [SCC ModSummary] -> [ModSummary]
forall a. [SCC a] -> [a]
flattenSCCs ([SCC ModSummary] -> [ModSummary])
-> [SCC ModSummary] -> [ModSummary]
forall a b. (a -> b) -> a -> b
$ [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules ([SCC ModuleGraphNode] -> [SCC ModSummary])
-> [SCC ModuleGraphNode] -> [SCC ModSummary]
forall a b. (a -> b) -> a -> b
$
Bool
-> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
GHC.topSortModuleGraph Bool
True ModuleGraph
g Maybe HomeUnitModule
forall a. Maybe a
Nothing
pick :: [ModSummary] -> Maybe [Char]
pick [ModSummary]
xs = case [ModSummary]
xs of
ModSummary
x : [ModSummary]
_ -> ModLocation -> Maybe [Char]
GHC.ml_hs_file (ModSummary -> ModLocation
GHC.ms_location ModSummary
x)
[ModSummary]
_ -> Maybe [Char]
forall a. Maybe a
Nothing
case [ModSummary] -> Maybe [Char]
pick (ModuleGraph -> [ModSummary]
order ModuleGraph
failed_graph) of
Just [Char]
file -> [Char] -> m [Char]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
file
Maybe [Char]
Nothing ->
do [Target]
targets <- m [Target]
forall (m :: Type -> Type). GhcMonad m => m [Target]
GHC.getTargets
case [Maybe [Char]] -> Maybe [Char]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Target -> Maybe [Char]) -> [Target] -> [Maybe [Char]]
forall a b. (a -> b) -> [a] -> [b]
map Target -> Maybe [Char]
fromTarget [Target]
targets) of
Just [Char]
file -> [Char] -> m [Char]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
file
Maybe [Char]
Nothing -> GhcException -> m [Char]
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"No files to edit.")
where fromTarget :: Target -> Maybe [Char]
fromTarget GHC.Target { targetId :: Target -> TargetId
targetId = GHC.TargetFile [Char]
f Maybe Phase
_ } = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f
fromTarget Target
_ = Maybe [Char]
forall a. Maybe a
Nothing
defineMacro :: GhciMonad m => Bool -> String -> m ()
defineMacro :: forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
defineMacro Bool
_ (Char
':':[Char]
_) = (IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
[Char]
"macro name cannot start with a colon")
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
defineMacro Bool
_ (Char
'!':[Char]
_) = (IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
[Char]
"macro name cannot start with an exclamation mark")
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
defineMacro Bool
overwrite [Char]
s = do
let ([Char]
macro_name, [Char]
definition) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
s
[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
let defined :: [[Char]]
defined = (Command -> [Char]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Command -> [Char]
cmdName [Command]
macros
if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
macro_name
then if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
defined
then IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"no macros defined"
else IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char]
"the following macros are defined:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[[Char]] -> [Char]
unlines [[Char]]
defined)
else do
Bool
isCommand <- Maybe Command -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Command -> Bool) -> m (Maybe Command) -> m Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m (Maybe Command)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
macro_name
let check_newname :: m ()
check_newname
| [Char]
macro_name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [[Char]]
defined = GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError
([Char]
"macro '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
macro_name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is already defined. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
hint))
| Bool
isCommand = GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError
([Char]
"macro '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
macro_name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' overwrites builtin command. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
hint))
| Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
hint :: [Char]
hint = [Char]
" Use ':def!' to overwrite."
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
overwrite m ()
check_newname
(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).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
step <- m (LHsExpr GhcPs)
m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: Type -> Type). GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr <- [Char] -> m (LHsExpr GhcPs)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (LHsExpr GhcPs)
GHC.parseExpr [Char]
definition
let stringTy :: LHsType GhcPs
stringTy :: LHsType GhcPs
stringTy = PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted IdP GhcPs
RdrName
stringTyCon_RDR
ioM :: LHsType GhcPs
ioM :: LHsType GhcPs
ioM = PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
ioTyConName) LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType GhcPs
stringTy
body :: LHsExpr GhcPs
body = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP GhcPs
RdrName
compose_RDR LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`mkHsApp` (LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
step)
LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`mkHsApp` (LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr)
tySig :: HsWildCardBndrs GhcPs (LocatedAn an (HsSigType GhcPs))
tySig = LocatedAn an (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn an (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs (LocatedAn an (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn an (HsSigType GhcPs)))
-> LocatedAn an (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn an (HsSigType GhcPs))
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> LocatedAn an (HsSigType GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsSigType GhcPs -> LocatedAn an (HsSigType GhcPs))
-> HsSigType GhcPs -> LocatedAn an (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType (LHsType GhcPs -> HsSigType GhcPs)
-> LHsType GhcPs -> HsSigType GhcPs
forall a b. (a -> b) -> a -> b
$
LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy LHsType GhcPs
stringTy LHsType GhcPs
ioM
new_expr :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
new_expr = SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
body LHsSigWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs))
forall {an}. HsWildCardBndrs GhcPs (LocatedAn an (HsSigType GhcPs))
tySig
ForeignHValue
hv <- LHsExpr GhcPs -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
new_expr
let newCmd :: Command
newCmd = Command { cmdName :: [Char]
cmdName = [Char]
macro_name
, cmdAction :: [Char] -> InputT GHCi CmdExecOutcome
cmdAction = GHCi CmdExecOutcome -> InputT GHCi CmdExecOutcome
forall (m :: Type -> Type) a. Monad m => m a -> InputT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi CmdExecOutcome -> InputT GHCi CmdExecOutcome)
-> ([Char] -> GHCi CmdExecOutcome)
-> [Char]
-> InputT GHCi CmdExecOutcome
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignHValue -> [Char] -> GHCi CmdExecOutcome
forall (m :: Type -> Type).
GhciMonad m =>
ForeignHValue -> [Char] -> m CmdExecOutcome
runMacro ForeignHValue
hv
, cmdHidden :: Bool
cmdHidden = Bool
False
, cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion
}
(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
s ->
let filtered :: [Command]
filtered = [ Command
cmd | Command
cmd <- [Command]
macros, Command -> [Char]
cmdName Command
cmd [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
macro_name ]
in GHCiState
s { ghci_macros = newCmd : filtered }
runMacro
:: GhciMonad m
=> GHC.ForeignHValue
-> String
-> m CmdExecOutcome
runMacro :: forall (m :: Type -> Type).
GhciMonad m =>
ForeignHValue -> [Char] -> m CmdExecOutcome
runMacro ForeignHValue
fun [Char]
s = do
Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[Char]
str <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ Interp -> ForeignHValue -> [Char] -> IO [Char]
evalStringToIOString Interp
interp ForeignHValue
fun [Char]
s
[[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands ([Char] -> [[Char]]
lines [Char]
str)
CmdExecOutcome -> m CmdExecOutcome
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CmdSuccess
undefineMacro :: GhciMonad m => String -> m ()
undefineMacro :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
undefineMacro [Char]
str = ([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
undef ([Char] -> [[Char]]
words [Char]
str)
where undef :: [Char] -> m ()
undef [Char]
macro_name = do
[Command]
cmds <- 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
if ([Char]
macro_name [Char] -> [[Char]] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` (Command -> [Char]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Command -> [Char]
cmdName [Command]
cmds)
then GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError
([Char]
"macro '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
macro_name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is not defined"))
else do
(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
s ->
GHCiState
s { ghci_macros = filter ((/= macro_name) . cmdName)
(ghci_macros s) }
cmdCmd :: GhciMonad m => String -> m ()
cmdCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
cmdCmd [Char]
str = (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).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
GenLocated SrcSpanAnnA (HsExpr GhcPs)
step <- m (LHsExpr GhcPs)
m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (m :: Type -> Type). GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr <- [Char] -> m (LHsExpr GhcPs)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (LHsExpr GhcPs)
GHC.parseExpr [Char]
str
let new_expr :: LHsExpr GhcPs
new_expr = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
step LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`mkHsApp` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr
ForeignHValue
hv <- LHsExpr GhcPs -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote LHsExpr GhcPs
new_expr
Interp
interp <- HscEnv -> Interp
hscInterp (HscEnv -> Interp) -> m HscEnv -> m Interp
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[Char]
cmds <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ Interp -> ForeignHValue -> IO [Char]
evalString Interp
interp ForeignHValue
hv
[[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands ([Char] -> [[Char]]
lines [Char]
cmds)
getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO :: forall (m :: Type -> Type). GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO = do
Name
ghciTyConName <- m Name
forall (m :: Type -> Type). GhcMonad m => m Name
GHC.getGHCiMonad
let stringTy :: LHsType GhcPs
stringTy = PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted IdP GhcPs
RdrName
stringTyCon_RDR
ghciM :: LHsType GhcPs
ghciM = PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
ghciTyConName) LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
stringTy
ioM :: LHsType GhcPs
ioM = PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
ioTyConName) LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
`nlHsAppTy` LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
stringTy
body :: LHsExpr GhcPs
body = IdP GhcPs -> LHsExpr GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
ghciStepIoMName)
tySig :: HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs))
tySig = LocatedAn AnnListItem (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs (LocatedAn AnnListItem (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs)))
-> LocatedAn AnnListItem (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs))
forall a b. (a -> b) -> a -> b
$ HsSigType GhcPs -> LocatedAn AnnListItem (HsSigType GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsSigType GhcPs -> LocatedAn AnnListItem (HsSigType GhcPs))
-> HsSigType GhcPs -> LocatedAn AnnListItem (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType (LHsType GhcPs -> HsSigType GhcPs)
-> LHsType GhcPs -> HsSigType GhcPs
forall a b. (a -> b) -> a -> b
$
LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy LHsType GhcPs
ghciM LHsType GhcPs
ioM
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> m (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExprWithTySig GhcPs
-> LHsExpr GhcPs -> LHsSigWcType (NoGhcTc GhcPs) -> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
body LHsSigWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (LocatedAn AnnListItem (HsSigType GhcPs))
tySig
checkModule :: GhciMonad m => String -> m ()
checkModule :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
checkModule [Char]
m = do
let modl :: ModuleName
modl = [Char] -> ModuleName
GHC.mkModuleName [Char]
m
Bool
ok <- (SourceError -> m Bool) -> m Bool -> m Bool
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (\SourceError
e -> SourceError -> m ()
forall (m :: Type -> Type).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit SourceError
e m () -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False) (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
TypecheckedModule
r <- ParsedModule -> m TypecheckedModule
forall (m :: Type -> Type).
GhcMonad m =>
ParsedModule -> m TypecheckedModule
GHC.typecheckModule (ParsedModule -> m TypecheckedModule)
-> m ParsedModule -> m TypecheckedModule
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ModSummary -> m ParsedModule
forall (m :: Type -> Type).
GhcMonad m =>
ModSummary -> m ParsedModule
GHC.parseModule (ModSummary -> m ParsedModule) -> m ModSummary -> m ParsedModule
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ModuleName -> m ModSummary
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m ModSummary
GHC.getModSummary ModuleName
modl
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
case TypecheckedModule -> ModuleInfo
forall m. TypecheckedMod m => m -> ModuleInfo
GHC.moduleInfo TypecheckedModule
r of
ModuleInfo
cm | Just [Name]
scope <- ModuleInfo -> Maybe [Name]
GHC.modInfoTopLevelScope ModuleInfo
cm ->
let
([Name]
loc, [Name]
glob) = Bool -> ([Name], [Name]) -> ([Name], [Name])
forall a. HasCallStack => Bool -> a -> a
assert ((Name -> Bool) -> [Name] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Name -> Bool
isExternalName [Name]
scope) (([Name], [Name]) -> ([Name], [Name]))
-> ([Name], [Name]) -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$
(Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
modl) (ModuleName -> Bool) -> (Name -> ModuleName) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName (GenModule Unit -> ModuleName)
-> (Name -> GenModule Unit) -> Name -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
GHC.nameModule) [Name]
scope
in
([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"global names: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
glob) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"local names: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
loc)
ModuleInfo
_ -> SDoc
forall doc. IsOutput doc => doc
empty
Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
SuccessFlag -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
SuccessFlag -> Bool -> m ()
afterLoad (Bool -> SuccessFlag
successIf Bool
ok) Bool
False
docCmd :: GHC.GhcMonad m => String -> m ()
docCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
docCmd [Char]
"" =
GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: ':doc <thing-you-want-docs-for>'")
docCmd [Char]
s = do
NonEmpty Name
names <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
s
NonEmpty DocComponents
docs <- (Name -> m DocComponents)
-> NonEmpty Name -> m (NonEmpty DocComponents)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse ([Char] -> Name -> m DocComponents
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Name -> m DocComponents
buildDocComponents [Char]
s) NonEmpty Name
names
let sdocs :: [SDoc]
sdocs = [DocComponents] -> [SDoc]
pprDocs (NonEmpty DocComponents -> [DocComponents]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty DocComponents
docs)
sdocs' :: SDoc
sdocs' = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"") [SDoc]
sdocs)
[Char]
sdoc <- SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUser' SDoc
sdocs'
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn [Char]
sdoc)
data DocComponents =
DocComponents
{ DocComponents -> Maybe [HsDoc GhcRn]
docs :: Maybe [HsDoc GhcRn]
, DocComponents -> Maybe SDoc
sigAndLoc :: Maybe SDoc
, DocComponents -> IntMap (HsDoc GhcRn)
argDocs :: IntMap (HsDoc GhcRn)
}
buildDocComponents :: GHC.GhcMonad m => String -> Name -> m DocComponents
buildDocComponents :: forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Name -> m DocComponents
buildDocComponents [Char]
str Name
name = do
Maybe TyThing
mbThing <- Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName Name
name
let sigAndLoc :: Maybe SDoc
sigAndLoc = [Char] -> TyThing -> SDoc
sigAndLocDoc [Char]
str (TyThing -> SDoc) -> Maybe TyThing -> Maybe SDoc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TyThing
mbThing
(Maybe [HsDoc GhcRn]
docs, IntMap (HsDoc GhcRn)
argDocs)
<- (GetDocsFailure -> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
-> ((Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
-> Either
GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GetDocsFailure -> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
forall (m :: Type -> Type) a. GhcMonad m => GetDocsFailure -> m a
handleGetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
(Either GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
-> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
-> m (Either
GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
-> m (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> m (Either
GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
forall (m :: Type -> Type).
GhcMonad m =>
Name
-> m (Either
GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
GHC.getDocs Name
name
DocComponents -> m DocComponents
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DocComponents{Maybe [HsDoc GhcRn]
Maybe SDoc
IntMap (HsDoc GhcRn)
docs :: Maybe [HsDoc GhcRn]
sigAndLoc :: Maybe SDoc
argDocs :: IntMap (HsDoc GhcRn)
sigAndLoc :: Maybe SDoc
docs :: Maybe [HsDoc GhcRn]
argDocs :: IntMap (HsDoc GhcRn)
..}
sigAndLocDoc :: String -> TyThing -> SDoc
sigAndLocDoc :: [Char] -> TyThing -> SDoc
sigAndLocDoc [Char]
str TyThing
tyThing =
let tyThingTyDoc :: TyThing -> SDoc
tyThingTyDoc :: TyThing -> SDoc
tyThingTyDoc = \case
AnId Id
i -> Type -> SDoc
pprSigmaType (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ Id -> Type
varType Id
i
AConLike (RealDataCon DataCon
dc) -> Type -> SDoc
pprSigmaType (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> DataCon -> Type
dataConDisplayType Bool
False DataCon
dc
AConLike (PatSynCon PatSyn
patSyn) -> PatSyn -> SDoc
pprPatSynType PatSyn
patSyn
ATyCon TyCon
tyCon -> Type -> SDoc
pprSigmaType (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon -> Type
GHC.tyConKind TyCon
tyCon
ACoAxiom CoAxiom Branched
_ -> SDoc
forall doc. IsOutput doc => doc
empty
tyDoc :: SDoc
tyDoc = TyThing -> SDoc
tyThingTyDoc TyThing
tyThing
sigDoc :: SDoc
sigDoc = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
nest Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
tyDoc)
comment :: SDoc
comment =
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\t' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"--"
, TyThing -> SDoc
pprTyThingCategory TyThing
tyThing
, [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"defined" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
pprNameDefnLoc (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tyThing)
]
in SDoc -> Int -> SDoc -> SDoc
hang SDoc
sigDoc Int
2 SDoc
comment
pprDocs :: [DocComponents] -> [SDoc]
pprDocs :: [DocComponents] -> [SDoc]
pprDocs [DocComponents]
docs
| [DocComponents] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [DocComponents]
nonEmptyDocs = DocComponents -> SDoc
pprDoc (DocComponents -> SDoc) -> [DocComponents] -> [SDoc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [DocComponents] -> [DocComponents]
forall a. Int -> [a] -> [a]
take Int
1 [DocComponents]
docs
| Bool
otherwise = DocComponents -> SDoc
pprDoc (DocComponents -> SDoc) -> [DocComponents] -> [SDoc]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [DocComponents]
nonEmptyDocs
where
empty :: DocComponents -> Bool
empty DocComponents{docs :: DocComponents -> Maybe [HsDoc GhcRn]
docs = Maybe [HsDoc GhcRn]
mb_decl_docs, argDocs :: DocComponents -> IntMap (HsDoc GhcRn)
argDocs = IntMap (HsDoc GhcRn)
arg_docs}
= Bool -> ([HsDoc GhcRn] -> Bool) -> Maybe [HsDoc GhcRn] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True [HsDoc GhcRn] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null Maybe [HsDoc GhcRn]
mb_decl_docs Bool -> Bool -> Bool
&& IntMap (HsDoc GhcRn) -> Bool
forall a. IntMap a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null IntMap (HsDoc GhcRn)
arg_docs
nonEmptyDocs :: [DocComponents]
nonEmptyDocs = (DocComponents -> Bool) -> [DocComponents] -> [DocComponents]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DocComponents -> Bool) -> DocComponents -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocComponents -> Bool
empty) [DocComponents]
docs
pprDoc :: DocComponents -> SDoc
pprDoc :: DocComponents -> SDoc
pprDoc DocComponents{sigAndLoc :: DocComponents -> Maybe SDoc
sigAndLoc = Maybe SDoc
mb_sig_loc, docs :: DocComponents -> Maybe [HsDoc GhcRn]
docs = Maybe [HsDoc GhcRn]
mb_decl_docs} =
SDoc -> ([HsDoc GhcRn] -> SDoc) -> Maybe [HsDoc GhcRn] -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"<has no documentation>")
[HsDoc GhcRn] -> SDoc
formatDoc
Maybe [HsDoc GhcRn]
mb_decl_docs
where
formatDoc :: [HsDoc GhcRn] -> SDoc
formatDoc [HsDoc GhcRn]
doc =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Maybe SDoc -> SDoc
forall a. a -> Maybe a -> a
fromMaybe SDoc
forall doc. IsOutput doc => doc
empty Maybe SDoc
mb_sig_loc
, [HsDocString] -> SDoc
pprHsDocStrings ([HsDocString] -> SDoc) -> [HsDocString] -> SDoc
forall a b. (a -> b) -> a -> b
$ (HsDoc GhcRn -> HsDocString) -> [HsDoc GhcRn] -> [HsDocString]
forall a b. (a -> b) -> [a] -> [b]
map HsDoc GhcRn -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString [HsDoc GhcRn]
doc
]
handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m a
handleGetDocsFailure :: forall (m :: Type -> Type) a. GhcMonad m => GetDocsFailure -> m a
handleGetDocsFailure GetDocsFailure
no_docs = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let msg :: [Char]
msg = DynFlags -> GetDocsFailure -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags GetDocsFailure
no_docs
GhcException -> m a
forall a. GhcException -> a
throwGhcException (GhcException -> m a) -> GhcException -> m a
forall a b. (a -> b) -> a -> b
$ case GetDocsFailure
no_docs of
NameHasNoModule {} -> [Char] -> GhcException
Sorry [Char]
msg
NoDocsInIface {} -> [Char] -> GhcException
InstallationError [Char]
msg
GetDocsFailure
InteractiveName -> [Char] -> GhcException
ProgramError [Char]
msg
instancesCmd :: String -> InputT GHCi ()
instancesCmd :: [Char] -> InputT GHCi ()
instancesCmd [Char]
"" =
GhcException -> InputT GHCi ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: ':instances <type-you-want-instances-for>'")
instancesCmd [Char]
s = do
(SourceError -> InputT GHCi ()) -> InputT GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> InputT GHCi ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- [Char] -> InputT GHCi Type
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Type
GHC.parseInstanceHead [Char]
s
[ClsInst]
res <- Type -> InputT GHCi [ClsInst]
forall (m :: Type -> Type). GhcMonad m => Type -> m [ClsInst]
GHC.getInstancesForType Type
ty
SDoc -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> InputT GHCi ()) -> SDoc -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ClsInst]
res
wrapDeferTypeErrors :: GHC.GhcMonad m => m a -> m a
wrapDeferTypeErrors :: forall (m :: Type -> Type) a. GhcMonad m => m a -> m a
wrapDeferTypeErrors m a
load =
m DynFlags -> (DynFlags -> m ()) -> (DynFlags -> m a) -> m a
forall (m :: Type -> Type) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
(do
!DynFlags
originalFlags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
m Bool -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> m Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags (DynFlags -> m Bool) -> DynFlags -> m Bool
forall a b. (a -> b) -> a -> b
$
GeneralFlag -> DynFlags -> DynFlags
setGeneralFlag' GeneralFlag
Opt_DeferTypeErrors DynFlags
originalFlags
DynFlags -> m DynFlags
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DynFlags
originalFlags)
(\DynFlags
originalFlags -> m Bool -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> m Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags DynFlags
originalFlags)
(\DynFlags
_ -> m a
load)
loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule :: forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule [([Char], Maybe UnitId, Maybe Phase)]
fs = do
(ActionStats
_, Either SomeException SuccessFlag
result) <- (SuccessFlag -> Maybe Integer)
-> m SuccessFlag
-> m (ActionStats, Either SomeException SuccessFlag)
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runAndPrintStats (Maybe Integer -> SuccessFlag -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) ([([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule' [([Char], Maybe UnitId, Maybe Phase)]
fs)
(SomeException -> m SuccessFlag)
-> (SuccessFlag -> m SuccessFlag)
-> Either SomeException SuccessFlag
-> m SuccessFlag
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO SuccessFlag -> m SuccessFlag
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO SuccessFlag -> m SuccessFlag)
-> (SomeException -> IO SuccessFlag)
-> SomeException
-> m SuccessFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> IO SuccessFlag
forall e a. Exception e => e -> IO a
Exception.throwIO) SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Either SomeException SuccessFlag
result
loadModule_ :: GhciMonad m => [FilePath] -> m ()
loadModule_ :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModule_ [[Char]]
fs = m SuccessFlag -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m SuccessFlag -> m ()) -> m SuccessFlag -> m ()
forall a b. (a -> b) -> a -> b
$ [([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule ([[Char]]
-> [Maybe UnitId]
-> [Maybe Phase]
-> [([Char], Maybe UnitId, Maybe Phase)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[Char]]
fs (Maybe UnitId -> [Maybe UnitId]
forall a. a -> [a]
repeat Maybe UnitId
forall a. Maybe a
Nothing) (Maybe Phase -> [Maybe Phase]
forall a. a -> [a]
repeat Maybe Phase
forall a. Maybe a
Nothing))
loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
loadModuleDefer :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModuleDefer = m () -> m ()
forall (m :: Type -> Type) a. GhcMonad m => m a -> m a
wrapDeferTypeErrors (m () -> m ()) -> ([[Char]] -> m ()) -> [[Char]] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModule_
loadModule' :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule' :: forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe UnitId, Maybe Phase)] -> m SuccessFlag
loadModule' [([Char], Maybe UnitId, Maybe Phase)]
files = do
let ([[Char]]
filenames, [Maybe UnitId]
uids, [Maybe Phase]
phases) = [([Char], Maybe UnitId, Maybe Phase)]
-> ([[Char]], [Maybe UnitId], [Maybe Phase])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [([Char], Maybe UnitId, Maybe Phase)]
files
[[Char]]
exp_filenames <- ([Char] -> m [Char]) -> [[Char]] -> m [[Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [[Char]]
filenames
let files' :: [([Char], Maybe UnitId, Maybe Phase)]
files' = [[Char]]
-> [Maybe UnitId]
-> [Maybe Phase]
-> [([Char], Maybe UnitId, Maybe Phase)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[Char]]
exp_filenames [Maybe UnitId]
uids [Maybe Phase]
phases
[Target]
targets <- (([Char], Maybe UnitId, Maybe Phase) -> m Target)
-> [([Char], Maybe UnitId, Maybe Phase)] -> m [Target]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\([Char]
file, Maybe UnitId
uid, Maybe Phase
phase) -> [Char] -> Maybe UnitId -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe UnitId -> Maybe Phase -> m Target
GHC.guessTarget [Char]
file Maybe UnitId
uid Maybe Phase
phase) [([Char], Maybe UnitId, Maybe Phase)]
files'
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let !dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let load_module :: m SuccessFlag
load_module = do
Bool
_ <- m Bool
forall (m :: Type -> Type). GhcMonad m => m Bool
GHC.abandonAll
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearCaches
[Target] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
targets
Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
False LoadHowMuch
LoadAllTargets
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciLeakCheck DynFlags
dflags
then do
LeakIndicators
leak_indicators <- IO LeakIndicators -> m LeakIndicators
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO LeakIndicators -> m LeakIndicators)
-> IO LeakIndicators -> m LeakIndicators
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO LeakIndicators
getLeakIndicators HscEnv
hsc_env
SuccessFlag
success <- m SuccessFlag
load_module
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> LeakIndicators -> IO ()
checkLeakIndicators DynFlags
dflags LeakIndicators
leak_indicators
SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
success
else
m SuccessFlag
load_module
addModule :: GhciMonad m => [FilePath] -> m ()
addModule :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
addModule [[Char]]
files = do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
revertCAFs
[[Char]]
files' <- ([Char] -> m [Char]) -> [[Char]] -> m [[Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [[Char]]
files
[Target]
targets <- ([Char] -> m Target) -> [[Char]] -> m [Target]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\[Char]
m -> [Char] -> Maybe UnitId -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe UnitId -> Maybe Phase -> m Target
GHC.guessTarget [Char]
m Maybe UnitId
forall a. Maybe a
Nothing Maybe Phase
forall a. Maybe a
Nothing) [[Char]]
files'
[Target]
targets' <- (Target -> m Bool) -> [Target] -> m [Target]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Target -> m Bool
forall (m :: Type -> Type). GhciMonad m => Target -> m Bool
checkTarget [Target]
targets
(TargetId -> m ()) -> [TargetId] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TargetId -> m ()
forall (m :: Type -> Type). GhcMonad m => TargetId -> m ()
GHC.removeTarget [ TargetId
tid | Target { targetId :: Target -> TargetId
targetId = TargetId
tid } <- [Target]
targets' ]
(Target -> m ()) -> [Target] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Target -> m ()
forall (m :: Type -> Type). GhcMonad m => Target -> m ()
GHC.addTarget [Target]
targets'
SuccessFlag
_ <- Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
False LoadHowMuch
LoadAllTargets
() -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
where
checkTarget :: GhciMonad m => Target -> m Bool
checkTarget :: forall (m :: Type -> Type). GhciMonad m => Target -> m Bool
checkTarget Target { targetId :: Target -> TargetId
targetId = TargetModule ModuleName
m } = ModuleName -> m Bool
forall (m :: Type -> Type). GhciMonad m => ModuleName -> m Bool
checkTargetModule ModuleName
m
checkTarget Target { targetId :: Target -> TargetId
targetId = TargetFile [Char]
f Maybe Phase
_ } = [Char] -> m Bool
forall (m :: Type -> Type). GhciMonad m => [Char] -> m Bool
checkTargetFile [Char]
f
checkTargetModule :: GhciMonad m => ModuleName -> m Bool
checkTargetModule :: forall (m :: Type -> Type). GhciMonad m => ModuleName -> m Bool
checkTargetModule ModuleName
m = do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
FindResult
result <- IO FindResult -> m FindResult
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> m FindResult) -> IO FindResult -> m FindResult
forall a b. (a -> b) -> a -> b
$
HscEnv -> ModuleName -> PkgQual -> IO FindResult
Finder.findImportedModule HscEnv
hsc_env ModuleName
m (UnitId -> PkgQual
ThisPkg (HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit))
case FindResult
result of
Found ModLocation
_ GenModule Unit
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
FindResult
_ -> do IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char]
"Module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
m [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found")
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
checkTargetFile :: GhciMonad m => String -> m Bool
checkTargetFile :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m Bool
checkTargetFile [Char]
f = do
Bool
exists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Bool
doesFileExist [Char]
f)
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
exists
unAddModule :: GhciMonad m => [FilePath] -> m ()
unAddModule :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
unAddModule [[Char]]
files = do
[[Char]]
files' <- ([Char] -> m [Char]) -> [[Char]] -> m [[Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [[Char]]
files
[Target]
targets <- ([Char] -> m Target) -> [[Char]] -> m [Target]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\[Char]
m -> [Char] -> Maybe UnitId -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe UnitId -> Maybe Phase -> m Target
GHC.guessTarget [Char]
m Maybe UnitId
forall a. Maybe a
Nothing Maybe Phase
forall a. Maybe a
Nothing) [[Char]]
files'
(TargetId -> m ()) -> [TargetId] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TargetId -> m ()
forall (m :: Type -> Type). GhcMonad m => TargetId -> m ()
GHC.removeTarget [ TargetId
tid | Target { targetId :: Target -> TargetId
targetId = TargetId
tid } <- [Target]
targets ]
SuccessFlag
_ <- Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
False LoadHowMuch
LoadAllTargets
() -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
reloadModule :: GhciMonad m => String -> m ()
reloadModule :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule [Char]
m = do
HscEnv
session <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let home_unit :: UnitId
home_unit = HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId (HscEnv -> HomeUnit
hsc_home_unit HscEnv
session)
SuccessFlag
ok <- Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
True (UnitId -> LoadHowMuch
loadTargets UnitId
home_unit)
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (SuccessFlag -> Bool
failed SuccessFlag
ok) m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
where
loadTargets :: UnitId -> LoadHowMuch
loadTargets UnitId
hu | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
m = LoadHowMuch
LoadAllTargets
| Bool
otherwise = HomeUnitModule -> LoadHowMuch
LoadUpTo (UnitId -> ModuleName -> HomeUnitModule
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
hu ([Char] -> ModuleName
GHC.mkModuleName [Char]
m))
reloadModuleDefer :: GhciMonad m => String -> m ()
reloadModuleDefer :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModuleDefer = m () -> m ()
forall (m :: Type -> Type) a. GhcMonad m => m a -> m a
wrapDeferTypeErrors (m () -> m ()) -> ([Char] -> m ()) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule
doLoadAndCollectInfo :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
retain_context LoadHowMuch
howmuch = do
Bool
doCollectInfo <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
CollectInfo
Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoad Bool
retain_context LoadHowMuch
howmuch m SuccessFlag -> (SuccessFlag -> m SuccessFlag) -> m SuccessFlag
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
SuccessFlag
Succeeded | Bool
doCollectInfo -> do
[ModSummary]
mod_summaries <- ModuleGraph -> [ModSummary]
GHC.mgModSummaries (ModuleGraph -> [ModSummary]) -> m ModuleGraph -> m [ModSummary]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
getModuleGraph
[ModuleName]
loaded <- (ModuleName -> m Bool) -> [ModuleName] -> m [ModuleName]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModuleName -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Bool
GHC.isLoaded ((ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
ms_mod_name [ModSummary]
mod_summaries)
Map ModuleName ModInfo
v <- GHCiState -> Map ModuleName ModInfo
mod_infos (GHCiState -> Map ModuleName ModInfo)
-> m GHCiState -> m (Map ModuleName ModInfo)
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
!Map ModuleName ModInfo
newInfos <- Map ModuleName ModInfo
-> [ModuleName] -> m (Map ModuleName ModInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Map ModuleName ModInfo
-> [ModuleName] -> m (Map ModuleName ModInfo)
collectInfo Map ModuleName ModInfo
v [ModuleName]
loaded
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { mod_infos = newInfos })
SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Succeeded
SuccessFlag
flag -> SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
flag
doLoad :: GhciMonad m => Bool -> LoadHowMuch -> m SuccessFlag
doLoad :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoad Bool
retain_context LoadHowMuch
howmuch = do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardActiveBreakPoints
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
resetLastErrorLocations
m () -> (() -> m ()) -> (() -> m SuccessFlag) -> m SuccessFlag
forall (m :: Type -> Type) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket (IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering)
(\()
_ ->
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering) ((() -> m SuccessFlag) -> m SuccessFlag)
-> (() -> m SuccessFlag) -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ \()
_ -> do
ModIfaceCache
hmis <- GHCiState -> ModIfaceCache
ifaceCache (GHCiState -> ModIfaceCache) -> m GHCiState -> m ModIfaceCache
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
SuccessFlag
ok <- m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ Maybe ModIfaceCache -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
Maybe ModIfaceCache -> LoadHowMuch -> m SuccessFlag
GHC.loadWithCache (ModIfaceCache -> Maybe ModIfaceCache
forall a. a -> Maybe a
Just ModIfaceCache
hmis) LoadHowMuch
howmuch
SuccessFlag -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
SuccessFlag -> Bool -> m ()
afterLoad SuccessFlag
ok Bool
retain_context
SuccessFlag -> m SuccessFlag
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
ok
afterLoad
:: GhciMonad m
=> SuccessFlag
-> Bool
-> m ()
afterLoad :: forall (m :: Type -> Type).
GhciMonad m =>
SuccessFlag -> Bool -> m ()
afterLoad SuccessFlag
ok Bool
retain_context = do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
revertCAFs
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardTickArrays
[ModSummary]
loaded_mods <- m [ModSummary]
forall (m :: Type -> Type). GhcMonad m => m [ModSummary]
getLoadedModules
SuccessFlag -> [ModSummary] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
SuccessFlag -> [ModSummary] -> m ()
modulesLoadedMsg SuccessFlag
ok [ModSummary]
loaded_mods
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
Bool -> Maybe ModuleGraph -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> Maybe ModuleGraph -> m ()
setContextAfterLoad Bool
retain_context (ModuleGraph -> Maybe ModuleGraph
forall a. a -> Maybe a
Just ModuleGraph
graph)
setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
setContextAfterLoad :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> Maybe ModuleGraph -> m ()
setContextAfterLoad Bool
keep_ctxt Maybe ModuleGraph
Nothing = do
Bool -> [InteractiveImport] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [InteractiveImport] -> m ()
setContextKeepingPackageModules Bool
keep_ctxt []
setContextAfterLoad Bool
keep_ctxt (Just ModuleGraph
graph) = do
[Target]
targets <- m [Target]
forall (m :: Type -> Type). GhcMonad m => m [Target]
GHC.getTargets
[ModuleGraphNode]
loaded_graph <- (ModuleGraphNode -> m Bool)
-> [ModuleGraphNode] -> m [ModuleGraphNode]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModuleGraphNode -> m Bool
forall {f :: Type -> Type}. GhcMonad f => ModuleGraphNode -> f Bool
is_loaded ([ModuleGraphNode] -> m [ModuleGraphNode])
-> [ModuleGraphNode] -> m [ModuleGraphNode]
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModuleGraphNode]
GHC.mgModSummaries' ModuleGraph
graph
case [ ModSummary
m | Just ModSummary
m <- (Target -> Maybe ModSummary) -> [Target] -> [Maybe ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map ([ModuleGraphNode] -> Target -> Maybe ModSummary
findTarget [ModuleGraphNode]
loaded_graph) [Target]
targets ] of
[] ->
let graph' :: [ModSummary]
graph' = [SCC ModSummary] -> [ModSummary]
forall a. [SCC a] -> [a]
flattenSCCs ([SCC ModSummary] -> [ModSummary])
-> [SCC ModSummary] -> [ModSummary]
forall a b. (a -> b) -> a -> b
$ [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules ([SCC ModuleGraphNode] -> [SCC ModSummary])
-> [SCC ModuleGraphNode] -> [SCC ModSummary]
forall a b. (a -> b) -> a -> b
$
Bool
-> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
GHC.topSortModuleGraph Bool
True ([ModuleGraphNode] -> ModuleGraph
GHC.mkModuleGraph [ModuleGraphNode]
loaded_graph) Maybe HomeUnitModule
forall a. Maybe a
Nothing
in case [ModSummary]
graph' of
[] -> Bool -> [InteractiveImport] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [InteractiveImport] -> m ()
setContextKeepingPackageModules Bool
keep_ctxt []
[ModSummary]
xs -> ModSummary -> m ()
load_this ([ModSummary] -> ModSummary
forall a. HasCallStack => [a] -> a
last [ModSummary]
xs)
(ModSummary
m:[ModSummary]
_) ->
ModSummary -> m ()
load_this ModSummary
m
where
is_loaded :: ModuleGraphNode -> m Bool
is_loaded (GHC.ModuleNode [NodeKey]
_ ModSummary
ms) = ModSummary -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModSummary -> m Bool
isLoadedModSummary ModSummary
ms
is_loaded ModuleGraphNode
_ = Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
findTarget :: [ModuleGraphNode] -> Target -> Maybe ModSummary
findTarget [ModuleGraphNode]
mds Target
t
= case (ModuleGraphNode -> Maybe ModSummary)
-> [ModuleGraphNode] -> [ModSummary]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleGraphNode -> Target -> Maybe ModSummary
`matches` Target
t) [ModuleGraphNode]
mds of
[] -> Maybe ModSummary
forall a. Maybe a
Nothing
(ModSummary
m:[ModSummary]
_) -> ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
m
(GHC.ModuleNode [NodeKey]
_ ModSummary
summary) matches :: ModuleGraphNode -> Target -> Maybe ModSummary
`matches` Target { targetId :: Target -> TargetId
targetId = TargetModule ModuleName
m }
= if ModSummary -> ModuleName
GHC.ms_mod_name ModSummary
summary ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m then ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
summary else Maybe ModSummary
forall a. Maybe a
Nothing
(GHC.ModuleNode [NodeKey]
_ ModSummary
summary) `matches` Target { targetId :: Target -> TargetId
targetId = TargetFile [Char]
f Maybe Phase
_ }
| Just [Char]
f' <- ModLocation -> Maybe [Char]
GHC.ml_hs_file (ModSummary -> ModLocation
GHC.ms_location ModSummary
summary) =
if [Char]
f [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
f' then ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
summary else Maybe ModSummary
forall a. Maybe a
Nothing
ModuleGraphNode
_ `matches` Target
_ = Maybe ModSummary
forall a. Maybe a
Nothing
load_this :: ModSummary -> m ()
load_this ModSummary
summary | GenModule Unit
m <- ModSummary -> GenModule Unit
GHC.ms_mod ModSummary
summary = do
Bool
is_interp <- GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.moduleIsInterpreted GenModule Unit
m
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let star_ok :: Bool
star_ok = Bool
is_interp Bool -> Bool -> Bool
&& Bool -> Bool
not (DynFlags -> Bool
safeLanguageOn DynFlags
dflags)
let new_ctx :: [InteractiveImport]
new_ctx | Bool
star_ok = [ModuleName -> InteractiveImport
mkIIModule (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName GenModule Unit
m)]
| Bool
otherwise = [ModuleName -> InteractiveImport
mkIIDecl (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName GenModule Unit
m)]
Bool -> [InteractiveImport] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [InteractiveImport] -> m ()
setContextKeepingPackageModules Bool
keep_ctxt [InteractiveImport]
new_ctx
setContextKeepingPackageModules
:: GhciMonad m
=> Bool
-> [InteractiveImport]
-> m ()
setContextKeepingPackageModules :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [InteractiveImport] -> m ()
setContextKeepingPackageModules Bool
keep_ctx [InteractiveImport]
trans_ctx = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let rem_ctx :: [InteractiveImport]
rem_ctx = GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st
[InteractiveImport]
new_rem_ctx <- if Bool
keep_ctx then [InteractiveImport] -> m [InteractiveImport]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [InteractiveImport]
rem_ctx
else [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type).
GhcMonad m =>
[InteractiveImport] -> m [InteractiveImport]
keepPackageImports [InteractiveImport]
rem_ctx
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ remembered_ctx = new_rem_ctx,
transient_ctx = filterSubsumed new_rem_ctx trans_ctx }
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState
keepPackageImports
:: GHC.GhcMonad m => [InteractiveImport] -> m [InteractiveImport]
keepPackageImports :: forall (m :: Type -> Type).
GhcMonad m =>
[InteractiveImport] -> m [InteractiveImport]
keepPackageImports = (InteractiveImport -> m Bool)
-> [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM InteractiveImport -> m Bool
forall (m :: Type -> Type).
GhcMonad m =>
InteractiveImport -> m Bool
is_pkg_import
where
is_pkg_import :: GHC.GhcMonad m => InteractiveImport -> m Bool
is_pkg_import :: forall (m :: Type -> Type).
GhcMonad m =>
InteractiveImport -> m Bool
is_pkg_import (IIModule ModuleName
_) = Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
is_pkg_import (IIDecl ImportDecl GhcPs
d)
= do PkgQual
pkgqual <- ModuleName -> RawPkgQual -> m PkgQual
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> RawPkgQual -> m PkgQual
GHC.renameRawPkgQualM (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d) (ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
d)
Either SomeException (GenModule Unit)
e <- m (GenModule Unit) -> m (Either SomeException (GenModule Unit))
forall (m :: Type -> Type) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try (m (GenModule Unit) -> m (Either SomeException (GenModule Unit)))
-> m (GenModule Unit) -> m (Either SomeException (GenModule Unit))
forall a b. (a -> b) -> a -> b
$ PkgQual -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
PkgQual -> ModuleName -> m (GenModule Unit)
GHC.findQualifiedModule PkgQual
pkgqual ModuleName
mod_name
case Either SomeException (GenModule Unit)
e :: Either SomeException Module of
Left SomeException
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
Right GenModule Unit
m -> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> Bool
not (GenModule Unit -> Bool
isMainUnitModule GenModule Unit
m))
where
mod_name :: ModuleName
mod_name = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d)
modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()
modulesLoadedMsg :: forall (m :: Type -> Type).
GhcMonad m =>
SuccessFlag -> [ModSummary] -> m ()
modulesLoadedMsg SuccessFlag
ok [ModSummary]
mods = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
SDoc
msg <- if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ShowLoadedModules DynFlags
dflags
then do
[SDoc]
mod_names <- (ModSummary -> m SDoc) -> [ModSummary] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM ModSummary -> m SDoc
forall {m :: Type -> Type}. GhcMonad m => ModSummary -> m SDoc
mod_name [ModSummary]
mods
let mod_commas :: SDoc
mod_commas
| [ModSummary] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [ModSummary]
mods = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"none."
| Bool
otherwise = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
mod_names) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"."
SDoc -> m SDoc
forall a. a -> m a
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
status SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
", modules loaded:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
mod_commas
else do
SDoc -> m SDoc
forall a. a -> m a
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
status SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
","
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf ([ModSummary] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ModSummary]
mods) ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"module") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"loaded."
Bool -> m () -> m ()
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) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Char]
rendered_msg <- SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUser' SDoc
msg
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
rendered_msg
where
status :: SDoc
status = case SuccessFlag
ok of
SuccessFlag
Failed -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Failed"
SuccessFlag
Succeeded -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Ok"
mod_name :: ModSummary -> m SDoc
mod_name ModSummary
mod = do
Bool
is_interpreted <- ModSummary -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModSummary -> m Bool
GHC.moduleIsBootOrNotObjectLinkable ModSummary
mod
SDoc -> m SDoc
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ if Bool
is_interpreted
then GenModule Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> GenModule Unit
GHC.ms_mod ModSummary
mod)
else GenModule Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> GenModule Unit
GHC.ms_mod ModSummary
mod)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
normalise ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ModSummary -> [Char]
msObjFilePath ModSummary
mod)
runExceptGhciMonad :: GhciMonad m => ExceptT SDoc m () -> m ()
runExceptGhciMonad :: forall (m :: Type -> Type).
GhciMonad m =>
ExceptT SDoc m () -> m ()
runExceptGhciMonad ExceptT SDoc m ()
act = (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).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(SDoc -> m ()) -> (() -> m ()) -> Either SDoc () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SDoc -> m ()
forall {m :: Type -> Type}. GhciMonad m => SDoc -> m ()
handleErr () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either SDoc () -> m ()) -> m (Either SDoc ()) -> m ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
ExceptT SDoc m () -> m (Either SDoc ())
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT SDoc m ()
act
where
handleErr :: SDoc -> m ()
handleErr SDoc
sdoc = do
[Char]
rendered <- SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUserQualify SDoc
sdoc
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
rendered
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode
exceptT :: Applicative m => Either e a -> ExceptT e m a
exceptT :: forall (m :: Type -> Type) e a.
Applicative m =>
Either e a -> ExceptT e m a
exceptT = m (Either e a) -> ExceptT e m a
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> (Either e a -> m (Either e a)) -> Either e a -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
makeHDL'
:: forall backend
. Backend backend
=> Proxy backend
-> IORef ClashOpts
-> [FilePath]
-> InputT GHCi ()
makeHDL' :: forall backend.
Backend backend =>
Proxy backend -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeHDL' Proxy backend
backend IORef ClashOpts
opts [[Char]]
lst = [[Char]] -> InputT GHCi ()
go ([[Char]] -> InputT GHCi ())
-> InputT GHCi [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< case [[Char]]
lst of
srcs :: [[Char]]
srcs@([Char]
_:[[Char]]
_) -> [[Char]] -> InputT GHCi [[Char]]
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [[Char]]
srcs
[] -> do
ModuleGraph
modGraph <- InputT GHCi ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let sortedGraph :: [SCC ModSummary]
sortedGraph =
[SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules ([SCC ModuleGraphNode] -> [SCC ModSummary])
-> [SCC ModuleGraphNode] -> [SCC ModSummary]
forall a b. (a -> b) -> a -> b
$
Bool
-> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
GHC.topSortModuleGraph Bool
False ModuleGraph
modGraph Maybe HomeUnitModule
forall a. Maybe a
Nothing
[[Char]] -> InputT GHCi [[Char]]
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([[Char]] -> InputT GHCi [[Char]])
-> [[Char]] -> InputT GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ case ([SCC ModSummary] -> [SCC ModSummary]
forall a. [a] -> [a]
reverse [SCC ModSummary]
sortedGraph) of
((AcyclicSCC ModSummary
top) : [SCC ModSummary]
_) -> Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (ModLocation -> Maybe [Char]
GHC.ml_hs_file (ModLocation -> Maybe [Char])
-> (ModSummary -> ModLocation) -> ModSummary -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModLocation
GHC.ms_location) ModSummary
top
[SCC ModSummary]
_ -> []
where
go :: [[Char]] -> InputT GHCi ()
go [[Char]]
srcs = do
DynFlags
dflags <- InputT GHCi DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
DynFlags -> [[Char]] -> InputT GHCi ()
goX DynFlags
dflags [[Char]]
srcs InputT GHCi () -> InputT GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`MC.finally` DynFlags -> InputT GHCi ()
forall {m :: Type -> Type}. GhciMonad m => DynFlags -> m ()
recover DynFlags
dflags
goX :: DynFlags -> [[Char]] -> InputT GHCi ()
goX DynFlags
dflags [[Char]]
srcs = do
(DynFlags
dflagsX,[Located [Char]]
_,[Warn]
_) <- DynFlags
-> [Located [Char]]
-> InputT GHCi (DynFlags, [Located [Char]], [Warn])
forall (m :: Type -> Type).
MonadIO m =>
DynFlags
-> [Located [Char]] -> m (DynFlags, [Located [Char]], [Warn])
parseDynamicFlagsCmdLine DynFlags
dflags
[ [Char] -> Located [Char]
forall e. e -> Located e
noLoc [Char]
"-fobject-code"
, [Char] -> Located [Char]
forall e. e -> Located e
noLoc [Char]
"-fforce-recomp"
, [Char] -> Located [Char]
forall e. e -> Located e
noLoc [Char]
"-keep-tmp-files"
]
()
_ <- DynFlags -> InputT GHCi ()
forall (m :: Type -> Type).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflagsX
[Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule [Char]
""
HscEnv
env <- InputT GHCi HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
IO () -> InputT GHCi ()
forall a. IO a -> InputT GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Interp -> HscEnv -> [Linkable] -> IO ()
Loader.unload (HscEnv -> Interp
hscInterp HscEnv
env) HscEnv
env [])
Proxy backend
-> Ghc () -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
forall backend (m :: Type -> Type).
(GhcMonad m, Backend backend) =>
Proxy backend -> Ghc () -> IORef ClashOpts -> [[Char]] -> m ()
makeHDL Proxy backend
backend (() -> Ghc ()
forall a. a -> Ghc a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) IORef ClashOpts
opts [[Char]]
srcs
recover :: DynFlags -> m ()
recover DynFlags
dflags = do
()
_ <- DynFlags -> m ()
forall (m :: Type -> Type).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflags
[Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule [Char]
""
makeHDL
:: forall backend m
. (GHC.GhcMonad m, Backend backend)
=> Proxy backend
-> Ghc ()
-> IORef ClashOpts
-> [FilePath]
-> m ()
makeHDL :: forall backend (m :: Type -> Type).
(GhcMonad m, Backend backend) =>
Proxy backend -> Ghc () -> IORef ClashOpts -> [[Char]] -> m ()
makeHDL Proxy backend
Proxy Ghc ()
startAction IORef ClashOpts
optsRef [[Char]]
srcs = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do UTCTime
startTime <- IO UTCTime
Clock.getCurrentTime
ClashOpts
opts0 <- IORef ClashOpts -> IO ClashOpts
forall a. IORef a -> IO a
readIORef IORef ClashOpts
optsRef
let opts1 :: ClashOpts
opts1 = ClashOpts
opts0 { opt_color = useColor dflags }
let iw :: Int
iw = ClashOpts -> Int
opt_intWidth ClashOpts
opts1
hdl :: HDL
hdl = backend -> HDL
forall state. Backend state => state -> HDL
hdlKind backend
backend
outputDir :: Maybe [Char]
outputDir = do [Char]
odir <- DynFlags -> Maybe [Char]
objectDir DynFlags
dflags
[Char]
hidir <- DynFlags -> Maybe [Char]
hiDir DynFlags
dflags
[Char]
sdir <- DynFlags -> Maybe [Char]
stubDir DynFlags
dflags
[Char]
ddir <- DynFlags -> Maybe [Char]
dumpDir DynFlags
dflags
if ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
odir) [[Char]
hidir,[Char]
sdir,[Char]
ddir]
then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
odir
else Maybe [Char]
forall a. Maybe a
Nothing
idirs :: [[Char]]
idirs = DynFlags -> [[Char]]
importPaths DynFlags
dflags
opts2 :: ClashOpts
opts2 = ClashOpts
opts1 { opt_hdlDir = maybe outputDir Just (opt_hdlDir opts1)
, opt_importPaths = idirs}
backend :: backend
backend = forall state. Backend state => ClashOpts -> state
initBackend @backend ClashOpts
opts2
DynFlags -> IO ()
checkMonoLocalBinds DynFlags
dflags
ClashOpts -> [[Char]] -> IO ()
forall (t :: Type -> Type).
Foldable t =>
ClashOpts -> t [Char] -> IO ()
checkImportDirs ClashOpts
opts0 [[Char]]
idirs
[[Char]]
primDirs_ <- backend -> IO [[Char]]
forall state. Backend state => state -> IO [[Char]]
primDirs backend
backend
[[Char]] -> ([Char] -> IO ()) -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
srcs (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
src -> do
let dbs :: [[Char]]
dbs = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]
p | PackageDB (PkgDbPath [Char]
p) <- DynFlags -> [PackageDBFlag]
packageDBFlags DynFlags
dflags]
(ClashEnv
clashEnv, ClashDesign
clashDesign) <- ClashOpts
-> Ghc ()
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> HDL
-> [Char]
-> Maybe DynFlags
-> IO (ClashEnv, ClashDesign)
generateBindings ClashOpts
opts2 Ghc ()
startAction [[Char]]
primDirs_ [[Char]]
idirs [[Char]]
dbs HDL
hdl [Char]
src (DynFlags -> Maybe DynFlags
forall a. a -> Maybe a
Just DynFlags
dflags)
let getMain :: [Char] -> IO (TopEntityT, [TopEntityT])
getMain = HasCallStack =>
[Char] -> ClashDesign -> [Char] -> IO (TopEntityT, [TopEntityT])
[Char] -> ClashDesign -> [Char] -> IO (TopEntityT, [TopEntityT])
getMainTopEntity [Char]
src ClashDesign
clashDesign
Maybe (TopEntityT, [TopEntityT])
mainTopEntity <- ([Char] -> IO (TopEntityT, [TopEntityT]))
-> Maybe [Char] -> IO (Maybe (TopEntityT, [TopEntityT]))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse [Char] -> IO (TopEntityT, [TopEntityT])
getMain (DynFlags -> Maybe [Char]
GHC.mainFunIs DynFlags
dflags)
UTCTime
prepTime <- UTCTime
startTime UTCTime -> IO UTCTime -> IO UTCTime
forall a b. NFData a => a -> b -> b
`deepseq` ClashDesign -> BindingMap
designBindings ClashDesign
clashDesign BindingMap -> IO UTCTime -> IO UTCTime
forall a b. NFData a => a -> b -> b
`deepseq` ClashEnv -> TyConMap
envTyConMap ClashEnv
clashEnv TyConMap -> IO UTCTime -> IO UTCTime
forall a b. NFData a => a -> b -> b
`deepseq` IO UTCTime
Clock.getCurrentTime
let prepStartDiff :: [Char]
prepStartDiff = UTCTime -> UTCTime -> [Char]
reportTimeDiff UTCTime
prepTime UTCTime
startTime
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"GHC+Clash: Loading modules cumulatively took " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prepStartDiff
ClashEnv
-> ClashDesign
-> Maybe backend
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either [Char] FilteredHWType)))
-> Evaluator
-> Evaluator
-> Maybe (TopEntityT, [TopEntityT])
-> UTCTime
-> IO ()
forall backend.
Backend backend =>
ClashEnv
-> ClashDesign
-> Maybe backend
-> (CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either [Char] FilteredHWType)))
-> Evaluator
-> Evaluator
-> Maybe (TopEntityT, [TopEntityT])
-> UTCTime
-> IO ()
Clash.Driver.generateHDL
ClashEnv
clashEnv
ClashDesign
clashDesign
(backend -> Maybe backend
forall a. a -> Maybe a
Just backend
backend)
(Int
-> CustomReprs
-> TyConMap
-> Type
-> State HWMap (Maybe (Either [Char] FilteredHWType))
ghcTypeToHWType Int
iw)
Evaluator
ghcEvaluator
Evaluator
evaluator
Maybe (TopEntityT, [TopEntityT])
mainTopEntity
UTCTime
startTime
makeVHDL :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
makeVHDL :: IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVHDL = Proxy VHDLState -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
forall backend.
Backend backend =>
Proxy backend -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeHDL' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @VHDLState)
makeVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
makeVerilog :: IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVerilog = Proxy VerilogState -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
forall backend.
Backend backend =>
Proxy backend -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeHDL' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @VerilogState)
makeSystemVerilog :: IORef ClashOpts -> [FilePath] -> InputT GHCi ()
makeSystemVerilog :: IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeSystemVerilog = Proxy SystemVerilogState
-> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
forall backend.
Backend backend =>
Proxy backend -> IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeHDL' (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SystemVerilogState)
typeOfExpr :: GhciMonad m => String -> m ()
typeOfExpr :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeOfExpr [Char]
str = (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).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
str of
([Char]
"+v", [Char]
_) -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"`:type +v' has gone; use `:type' instead")
([Char]
"+d", [Char]
rest) -> TcRnExprMode -> [Char] -> m ()
forall {m :: Type -> Type}.
GhcMonad m =>
TcRnExprMode -> [Char] -> m ()
do_it TcRnExprMode
GHC.TM_Default ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
([Char], [Char])
_ -> TcRnExprMode -> [Char] -> m ()
forall {m :: Type -> Type}.
GhcMonad m =>
TcRnExprMode -> [Char] -> m ()
do_it TcRnExprMode
GHC.TM_Inst [Char]
str
where
do_it :: TcRnExprMode -> [Char] -> m ()
do_it TcRnExprMode
mode [Char]
expr_str
= do { Type
ty <- TcRnExprMode -> [Char] -> m Type
forall (m :: Type -> Type).
GhcMonad m =>
TcRnExprMode -> [Char] -> m Type
GHC.exprType TcRnExprMode
mode [Char]
expr_str
; SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
expr_str
, Int -> SDoc -> SDoc
nest Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty)] }
typeAtCmd :: GhciMonad m => String -> m ()
typeAtCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeAtCmd [Char]
str = ExceptT SDoc m () -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
ExceptT SDoc m () -> m ()
runExceptGhciMonad (ExceptT SDoc m () -> m ()) -> ExceptT SDoc m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(RealSrcSpan
span',[Char]
sample) <- Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall (m :: Type -> Type) e a.
Applicative m =>
Either e a -> ExceptT e m a
exceptT (Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char]))
-> Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either SDoc (RealSrcSpan, [Char])
parseSpanArg [Char]
str
Map ModuleName ModInfo
infos <- m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo))
-> m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall a b. (a -> b) -> a -> b
$ GHCiState -> Map ModuleName ModInfo
mod_infos (GHCiState -> Map ModuleName ModInfo)
-> m GHCiState -> m (Map ModuleName ModInfo)
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
(ModInfo
info, Type
ty) <- Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m (ModInfo, Type)
forall (m :: Type -> Type).
GhcMonad m =>
Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m (ModInfo, Type)
findType Map ModuleName ModInfo
infos RealSrcSpan
span' [Char]
sample
m () -> ExceptT SDoc m ()
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT SDoc m ()) -> m () -> ExceptT SDoc m ()
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> SDoc -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
ModuleInfo -> SDoc -> m ()
printForUserModInfo (ModInfo -> ModuleInfo
modinfoInfo ModInfo
info)
([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
sample,Int -> SDoc -> SDoc
nest Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)])
usesCmd :: GhciMonad m => String -> m ()
usesCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
usesCmd [Char]
str = ExceptT SDoc m () -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
ExceptT SDoc m () -> m ()
runExceptGhciMonad (ExceptT SDoc m () -> m ()) -> ExceptT SDoc m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(RealSrcSpan
span',[Char]
sample) <- Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall (m :: Type -> Type) e a.
Applicative m =>
Either e a -> ExceptT e m a
exceptT (Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char]))
-> Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either SDoc (RealSrcSpan, [Char])
parseSpanArg [Char]
str
Map ModuleName ModInfo
infos <- m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo))
-> m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall a b. (a -> b) -> a -> b
$ GHCiState -> Map ModuleName ModInfo
mod_infos (GHCiState -> Map ModuleName ModInfo)
-> m GHCiState -> m (Map ModuleName ModInfo)
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
[SrcSpan]
uses <- Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m [SrcSpan]
forall (m :: Type -> Type).
GhcMonad m =>
Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m [SrcSpan]
findNameUses Map ModuleName ModInfo
infos RealSrcSpan
span' [Char]
sample
[SrcSpan] -> (SrcSpan -> ExceptT SDoc m ()) -> ExceptT SDoc m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SrcSpan]
uses (IO () -> ExceptT SDoc m ()
forall a. IO a -> ExceptT SDoc m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SDoc m ())
-> (SrcSpan -> IO ()) -> SrcSpan -> ExceptT SDoc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (SrcSpan -> [Char]) -> SrcSpan -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> [Char]
showSrcSpan)
locAtCmd :: GhciMonad m => String -> m ()
locAtCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
locAtCmd [Char]
str = ExceptT SDoc m () -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
ExceptT SDoc m () -> m ()
runExceptGhciMonad (ExceptT SDoc m () -> m ()) -> ExceptT SDoc m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(RealSrcSpan
span',[Char]
sample) <- Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall (m :: Type -> Type) e a.
Applicative m =>
Either e a -> ExceptT e m a
exceptT (Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char]))
-> Either SDoc (RealSrcSpan, [Char])
-> ExceptT SDoc m (RealSrcSpan, [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Either SDoc (RealSrcSpan, [Char])
parseSpanArg [Char]
str
Map ModuleName ModInfo
infos <- m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo))
-> m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall a b. (a -> b) -> a -> b
$ GHCiState -> Map ModuleName ModInfo
mod_infos (GHCiState -> Map ModuleName ModInfo)
-> m GHCiState -> m (Map ModuleName ModInfo)
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
(ModInfo
_,Name
_,SrcSpan
sp) <- Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m (ModInfo, Name, SrcSpan)
forall (m :: Type -> Type).
GhcMonad m =>
Map ModuleName ModInfo
-> RealSrcSpan -> [Char] -> ExceptT SDoc m (ModInfo, Name, SrcSpan)
findLoc Map ModuleName ModInfo
infos RealSrcSpan
span' [Char]
sample
IO () -> ExceptT SDoc m ()
forall a. IO a -> ExceptT SDoc m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SDoc m ())
-> (SrcSpan -> IO ()) -> SrcSpan -> ExceptT SDoc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (SrcSpan -> [Char]) -> SrcSpan -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> [Char]
showSrcSpan (SrcSpan -> ExceptT SDoc m ()) -> SrcSpan -> ExceptT SDoc m ()
forall a b. (a -> b) -> a -> b
$ SrcSpan
sp
allTypesCmd :: GhciMonad m => String -> m ()
allTypesCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
allTypesCmd [Char]
_ = ExceptT SDoc m () -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
ExceptT SDoc m () -> m ()
runExceptGhciMonad (ExceptT SDoc m () -> m ()) -> ExceptT SDoc m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Map ModuleName ModInfo
infos <- m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo))
-> m (Map ModuleName ModInfo)
-> ExceptT SDoc m (Map ModuleName ModInfo)
forall a b. (a -> b) -> a -> b
$ GHCiState -> Map ModuleName ModInfo
mod_infos (GHCiState -> Map ModuleName ModInfo)
-> m GHCiState -> m (Map ModuleName ModInfo)
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
[ModInfo] -> (ModInfo -> ExceptT SDoc m ()) -> ExceptT SDoc m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ModuleName ModInfo -> [ModInfo]
forall k a. Map k a -> [a]
M.elems Map ModuleName ModInfo
infos) ((ModInfo -> ExceptT SDoc m ()) -> ExceptT SDoc m ())
-> (ModInfo -> ExceptT SDoc m ()) -> ExceptT SDoc m ()
forall a b. (a -> b) -> a -> b
$ \ModInfo
mi ->
[SpanInfo] -> (SpanInfo -> ExceptT SDoc m ()) -> ExceptT SDoc m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ModInfo -> [SpanInfo]
modinfoSpans ModInfo
mi) (m () -> ExceptT SDoc m ()
forall (m :: Type -> Type) a. Monad m => m a -> ExceptT SDoc m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT SDoc m ())
-> (SpanInfo -> m ()) -> SpanInfo -> ExceptT SDoc m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInfo -> m ()
forall {m :: Type -> Type}. GhcMonad m => SpanInfo -> m ()
printSpan)
where
printSpan :: SpanInfo -> m ()
printSpan SpanInfo
span'
| Just Type
ty <- SpanInfo -> Maybe Type
spaninfoType SpanInfo
span' = do
[Char]
tyInfo <- ([[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
words) ([Char] -> [Char]) -> m [Char] -> m [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUserQualify (Type -> SDoc
pprSigmaType Type
ty)
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ([Char] -> IO ()) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
RealSrcSpan -> [Char]
showRealSrcSpan (SpanInfo -> RealSrcSpan
spaninfoSrcSpan SpanInfo
span') [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tyInfo
| Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
parseSpanArg :: String -> Either SDoc (RealSrcSpan,String)
parseSpanArg :: [Char] -> Either SDoc (RealSrcSpan, [Char])
parseSpanArg [Char]
s = do
([Char]
fp,[Char]
s0) <- [Char] -> Either SDoc ([Char], [Char])
readAsString ([Char] -> [Char]
skipWs [Char]
s)
[Char]
s0' <- [Char] -> Either SDoc [Char]
skipWs1 [Char]
s0
(Int
sl,[Char]
s1) <- [Char] -> Either SDoc (Int, [Char])
readAsInt [Char]
s0'
[Char]
s1' <- [Char] -> Either SDoc [Char]
skipWs1 [Char]
s1
(Int
sc,[Char]
s2) <- [Char] -> Either SDoc (Int, [Char])
readAsInt [Char]
s1'
[Char]
s2' <- [Char] -> Either SDoc [Char]
skipWs1 [Char]
s2
(Int
el,[Char]
s3) <- [Char] -> Either SDoc (Int, [Char])
readAsInt [Char]
s2'
[Char]
s3' <- [Char] -> Either SDoc [Char]
skipWs1 [Char]
s3
(Int
ec,[Char]
s4) <- [Char] -> Either SDoc (Int, [Char])
readAsInt [Char]
s3'
[Char]
trailer <- case [Char]
s4 of
[] -> [Char] -> Either SDoc [Char]
forall a b. b -> Either a b
Right [Char]
""
[Char]
_ -> [Char] -> Either SDoc [Char]
skipWs1 [Char]
s4
let fs :: FastString
fs = [Char] -> FastString
mkFastString [Char]
fp
span' :: RealSrcSpan
span' = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fs Int
sl Int
sc)
(FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fs Int
el (Int
ec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
(RealSrcSpan, [Char]) -> Either SDoc (RealSrcSpan, [Char])
forall a. a -> Either SDoc a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (RealSrcSpan
span',[Char]
trailer)
where
readAsInt :: String -> Either SDoc (Int,String)
readAsInt :: [Char] -> Either SDoc (Int, [Char])
readAsInt [Char]
"" = SDoc -> Either SDoc (Int, [Char])
forall a b. a -> Either a b
Left SDoc
"Premature end of string while expecting Int"
readAsInt [Char]
s0 = case ReadS Int
forall a. Read a => ReadS a
reads [Char]
s0 of
[(Int, [Char])
s_rest] -> (Int, [Char]) -> Either SDoc (Int, [Char])
forall a b. b -> Either a b
Right (Int, [Char])
s_rest
[(Int, [Char])]
_ -> SDoc -> Either SDoc (Int, [Char])
forall a b. a -> Either a b
Left (SDoc
"Couldn't read" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"as Int")
readAsString :: String -> Either SDoc (String,String)
readAsString :: [Char] -> Either SDoc ([Char], [Char])
readAsString [Char]
s0
| Char
'"':[Char]
_ <- [Char]
s0 = case ReadS [Char]
forall a. Read a => ReadS a
reads [Char]
s0 of
[([Char], [Char])
s_rest] -> ([Char], [Char]) -> Either SDoc ([Char], [Char])
forall a b. b -> Either a b
Right ([Char], [Char])
s_rest
[([Char], [Char])]
_ -> Either SDoc ([Char], [Char])
leftRes
| s_rest :: ([Char], [Char])
s_rest@(Char
_:[Char]
_,[Char]
_) <- [Char] -> ([Char], [Char])
breakWs [Char]
s0 = ([Char], [Char]) -> Either SDoc ([Char], [Char])
forall a b. b -> Either a b
Right ([Char], [Char])
s_rest
| Bool
otherwise = Either SDoc ([Char], [Char])
leftRes
where
leftRes :: Either SDoc ([Char], [Char])
leftRes = SDoc -> Either SDoc ([Char], [Char])
forall a b. a -> Either a b
Left (SDoc
"Couldn't read" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"as String")
skipWs1 :: String -> Either SDoc String
skipWs1 :: [Char] -> Either SDoc [Char]
skipWs1 (Char
c:[Char]
cs) | Char -> Bool
isWs Char
c = [Char] -> Either SDoc [Char]
forall a b. b -> Either a b
Right ([Char] -> [Char]
skipWs [Char]
cs)
skipWs1 [Char]
s0 = SDoc -> Either SDoc [Char]
forall a b. a -> Either a b
Left (SDoc
"Expected whitespace in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0))
isWs :: Char -> Bool
isWs = (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
' ',Char
'\t'])
skipWs :: [Char] -> [Char]
skipWs = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWs
breakWs :: [Char] -> ([Char], [Char])
breakWs = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isWs
showSrcSpan :: SrcSpan -> String
showSrcSpan :: SrcSpan -> [Char]
showSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
s) = FastString -> [Char]
unpackFS (UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
s)
showSrcSpan (RealSrcSpan RealSrcSpan
spn Maybe BufSpan
_) = RealSrcSpan -> [Char]
showRealSrcSpan RealSrcSpan
spn
showRealSrcSpan :: RealSrcSpan -> String
showRealSrcSpan :: RealSrcSpan -> [Char]
showRealSrcSpan RealSrcSpan
spn = [[Char]] -> [Char]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ [Char]
fp, [Char]
":(", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sl, [Char]
",", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc
, [Char]
")-(", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
el, [Char]
",", Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ec, [Char]
")"
]
where
fp :: [Char]
fp = FastString -> [Char]
unpackFS (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
spn)
sl :: Int
sl = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
spn
sc :: Int
sc = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
spn
el :: Int
el = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn
ec :: Int
ec = let ec' :: Int
ec' = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
spn in if Int
ec' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
ec' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
kindOfType :: GhciMonad m => Bool -> String -> m ()
kindOfType :: forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
kindOfType Bool
norm [Char]
str = (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).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(Type
ty, Type
kind) <- Bool -> [Char] -> m (Type, Type)
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> [Char] -> m (Type, Type)
GHC.typeKind Bool
norm [Char]
str
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
kind
, Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
norm (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty ]
quit :: Monad m => String -> m CmdExecOutcome
quit :: forall (m :: Type -> Type). Monad m => [Char] -> m CmdExecOutcome
quit [Char]
_ = CmdExecOutcome -> m CmdExecOutcome
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CmdExecOutcome
CleanExit
scriptCmd :: String -> InputT GHCi ()
scriptCmd :: [Char] -> InputT GHCi ()
scriptCmd [Char]
ws = do
case [Char] -> [[Char]]
words' [Char]
ws of
[[Char]
s] -> [Char] -> InputT GHCi ()
runScript [Char]
s
[[Char]]
_ -> GhcException -> InputT GHCi ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: :script <filename>")
words' :: String -> [String]
words' :: [Char] -> [[Char]]
words' [Char]
s = case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
s of
[Char]
"" -> []
s' :: [Char]
s'@(Char
'\"' : [Char]
_) | [([Char]
w, [Char]
s'')] <- ReadS [Char]
forall a. Read a => ReadS a
reads [Char]
s' -> [Char]
w [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
words' [Char]
s''
[Char]
s' -> ([Char] -> [Char]) -> [Char] -> [[Char]]
go [Char] -> [Char]
forall a. a -> a
id [Char]
s'
where
go :: ([Char] -> [Char]) -> [Char] -> [[Char]]
go [Char] -> [Char]
acc [] = [[Char] -> [Char]
acc []]
go [Char] -> [Char]
acc (Char
'\\' : Char
c : [Char]
cs) | Char -> Bool
isSpace Char
c = ([Char] -> [Char]) -> [Char] -> [[Char]]
go ([Char] -> [Char]
acc ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)) [Char]
cs
go [Char] -> [Char]
acc (Char
c : [Char]
cs) | Char -> Bool
isSpace Char
c = [Char] -> [Char]
acc [] [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
words' [Char]
cs
| Bool
otherwise = ([Char] -> [Char]) -> [Char] -> [[Char]]
go ([Char] -> [Char]
acc ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)) [Char]
cs
runScript :: String
-> InputT GHCi ()
runScript :: [Char] -> InputT GHCi ()
runScript [Char]
filename = do
[Char]
filename' <- [Char] -> InputT GHCi [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [Char]
filename
Either IOException Handle
either_script <- IO (Either IOException Handle)
-> InputT GHCi (Either IOException Handle)
forall a. IO a -> InputT GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Handle)
-> InputT GHCi (Either IOException Handle))
-> IO (Either IOException Handle)
-> InputT 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]
filename' IOMode
ReadMode)
case Either IOException Handle
either_script of
Left IOException
_err -> GhcException -> InputT GHCi ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$ [Char]
"IO error: \""[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
filename[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\" "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(IOException -> [Char]
ioeGetErrorString IOException
_err))
Right Handle
script -> do
GHCiState
st <- InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let prog :: [Char]
prog = GHCiState -> [Char]
progname GHCiState
st
line :: Int
line = GHCiState -> Int
line_number GHCiState
st
GHCiState -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{progname=filename',line_number=0}
Handle -> InputT GHCi ()
scriptLoop Handle
script
IO () -> InputT GHCi ()
forall a. IO a -> InputT GHCi a
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 -> IO ()
hClose Handle
script
GHCiState
new_st <- InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
GHCiState -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
new_st{progname=prog,line_number=line}
where scriptLoop :: Handle -> InputT GHCi ()
scriptLoop Handle
script = do
Maybe Bool
res <- (SomeException -> GHCi Bool)
-> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool)
runOneCommand SomeException -> GHCi Bool
forall (m :: Type -> Type). GhciMonad m => SomeException -> m Bool
handler (InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Handle -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
script
case Maybe Bool
res of
Maybe Bool
Nothing -> () -> InputT GHCi ()
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just Bool
s -> if Bool
s
then Handle -> InputT GHCi ()
scriptLoop Handle
script
else () -> InputT GHCi ()
forall a. a -> InputT GHCi a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
isSafeCmd :: GHC.GhcMonad m => String -> m ()
isSafeCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
isSafeCmd [Char]
m =
case [Char] -> [[Char]]
words [Char]
m of
[[Char]
s] | [Char] -> Bool
looksLikeModuleName [Char]
s -> do
GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
lookupModule [Char]
s
GenModule Unit -> m ()
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m ()
isSafeModule GenModule Unit
md
[] -> do GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
guessCurrentModule [Char]
"issafe"
GenModule Unit -> m ()
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m ()
isSafeModule GenModule Unit
md
[[Char]]
_ -> GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: :issafe <module>")
isSafeModule :: GHC.GhcMonad m => Module -> m ()
isSafeModule :: forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m ()
isSafeModule GenModule Unit
m = do
Maybe ModuleInfo
mb_mod_info <- GenModule Unit -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Maybe ModuleInfo)
GHC.getModuleInfo GenModule Unit
m
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe ModuleInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleInfo
mb_mod_info)
(GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ()) -> GhcException -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown module: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mname)
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let iface :: Maybe ModIface
iface = ModuleInfo -> Maybe ModIface
GHC.modInfoIface (ModuleInfo -> Maybe ModIface) -> ModuleInfo -> Maybe ModIface
forall a b. (a -> b) -> a -> b
$ Maybe ModuleInfo -> ModuleInfo
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ModuleInfo
mb_mod_info
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe ModIface -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModIface
iface)
(GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ()) -> GhcException -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$ [Char]
"can't load interface file for module: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
(ModuleName -> [Char]
GHC.moduleNameString (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName GenModule Unit
m))
(Bool
msafe, Set UnitId
pkgs) <- GenModule Unit -> m (Bool, Set UnitId)
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Bool, Set UnitId)
GHC.moduleTrustReqs GenModule Unit
m
let trust :: [Char]
trust = SafeHaskellMode -> [Char]
forall a. Show a => a -> [Char]
show (SafeHaskellMode -> [Char]) -> SafeHaskellMode -> [Char]
forall a b. (a -> b) -> a -> b
$ IfaceTrustInfo -> SafeHaskellMode
getSafeMode (IfaceTrustInfo -> SafeHaskellMode)
-> IfaceTrustInfo -> SafeHaskellMode
forall a b. (a -> b) -> a -> b
$ ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
GHC.mi_trust (ModIface -> IfaceTrustInfo) -> ModIface -> IfaceTrustInfo
forall a b. (a -> b) -> a -> b
$ Maybe ModIface -> ModIface
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ModIface
iface
pkg :: [Char]
pkg = if HscEnv -> GenModule Unit -> Bool
packageTrusted HscEnv
hsc_env GenModule Unit
m then [Char]
"trusted" else [Char]
"untrusted"
(Set UnitId
good, Set UnitId
bad) = HscEnv -> Set UnitId -> (Set UnitId, Set UnitId)
tallyPkgs HscEnv
hsc_env Set UnitId
pkgs
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Trust type is (Module: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
trust [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", Package: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pkg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Package Trust: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if DynFlags -> Bool
packageTrustOn DynFlags
dflags then [Char]
"On" else [Char]
"Off")
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set UnitId -> Bool
forall a. Set a -> Bool
S.null Set UnitId
good)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Trusted package dependencies (trusted): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (UnitId -> [Char]) -> [UnitId] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> UnitId -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags) (Set UnitId -> [UnitId]
forall a. Set a -> [a]
S.toList Set UnitId
good)))
case Bool
msafe Bool -> Bool -> Bool
&& Set UnitId -> Bool
forall a. Set a -> Bool
S.null Set UnitId
bad of
Bool
True -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
mname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is trusted!"
Bool
False -> do
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set UnitId -> Bool
forall a. Set a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null Set UnitId
bad)
(IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Trusted package dependencies (untrusted): "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (UnitId -> [Char]) -> [UnitId] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> UnitId -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags) (Set UnitId -> [UnitId]
forall a. Set a -> [a]
S.toList Set UnitId
bad)))
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
mname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is NOT trusted!"
where
mname :: [Char]
mname = ModuleName -> [Char]
GHC.moduleNameString (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName GenModule Unit
m
packageTrusted :: HscEnv -> GenModule Unit -> Bool
packageTrusted HscEnv
hsc_env GenModule Unit
md
| HomeUnit -> GenModule Unit -> Bool
isHomeModule (HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env) GenModule Unit
md = Bool
True
| Bool
otherwise = GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsTrusted (GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool)
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) =>
UnitState
-> Unit
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
UnitState
-> Unit
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
unsafeLookupUnit ((() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env) (GenModule Unit -> Unit
forall unit. GenModule unit -> unit
moduleUnit GenModule Unit
md)
tallyPkgs :: HscEnv -> Set UnitId -> (Set UnitId, Set UnitId)
tallyPkgs HscEnv
hsc_env Set UnitId
deps | Bool -> Bool
not (DynFlags -> Bool
packageTrustOn DynFlags
dflags) = (Set UnitId
forall a. Set a
S.empty, Set UnitId
forall a. Set a
S.empty)
| Bool
otherwise = (UnitId -> Bool) -> Set UnitId -> (Set UnitId, Set UnitId)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition UnitId -> Bool
part Set UnitId
deps
where part :: UnitId -> Bool
part UnitId
pkg = GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsTrusted (GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool)
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
-> Bool
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) =>
UnitState
-> UnitId
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
UnitState
-> UnitId
-> GenericUnitInfo
PackageId PackageName UnitId ModuleName (GenModule Unit)
unsafeLookupUnitId UnitState
unit_state UnitId
pkg
unit_state :: UnitState
unit_state = (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
browseCmd :: GHC.GhcMonad m => Bool -> String -> m ()
browseCmd :: forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
browseCmd Bool
bang [Char]
m =
case [Char] -> [[Char]]
words [Char]
m of
[Char
'*':[Char]
s] | [Char] -> Bool
looksLikeModuleName [Char]
s -> do
GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
wantInterpretedModule [Char]
s
Bool -> GenModule Unit -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> GenModule Unit -> Bool -> m ()
browseModule Bool
bang GenModule Unit
md Bool
False
[[Char]
s] | [Char] -> Bool
looksLikeModuleName [Char]
s -> do
GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
lookupModule [Char]
s
Bool -> GenModule Unit -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> GenModule Unit -> Bool -> m ()
browseModule Bool
bang GenModule Unit
md Bool
True
[] -> do GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
guessCurrentModule ([Char]
"browse" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
bang then [Char]
"!" else [Char]
"")
Bool -> GenModule Unit -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> GenModule Unit -> Bool -> m ()
browseModule Bool
bang GenModule Unit
md Bool
True
[[Char]]
_ -> GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: :browse <module>")
guessCurrentModule :: GHC.GhcMonad m => String -> m Module
guessCurrentModule :: forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
guessCurrentModule [Char]
cmd = do
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
case [InteractiveImport]
imports of
[] -> GhcException -> m (GenModule Unit)
forall a. GhcException -> a
throwGhcException (GhcException -> m (GenModule Unit))
-> GhcException -> m (GenModule Unit)
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError (Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": no current module")
IIModule ModuleName
m : [InteractiveImport]
_ -> PkgQual -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
PkgQual -> ModuleName -> m (GenModule Unit)
GHC.findQualifiedModule PkgQual
NoPkgQual ModuleName
m
IIDecl ImportDecl GhcPs
d : [InteractiveImport]
_ -> do
PkgQual
pkgqual <- ModuleName -> RawPkgQual -> m PkgQual
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> RawPkgQual -> m PkgQual
GHC.renameRawPkgQualM (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d) (ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
d)
PkgQual -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
PkgQual -> ModuleName -> m (GenModule Unit)
GHC.findQualifiedModule PkgQual
pkgqual (GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d))
browseModule :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()
browseModule :: forall (m :: Type -> Type).
GhcMonad m =>
Bool -> GenModule Unit -> Bool -> m ()
browseModule Bool
bang GenModule Unit
modl Bool
exports_only = do
Maybe ModuleInfo
mb_mod_info <- GenModule Unit -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Maybe ModuleInfo)
GHC.getModuleInfo GenModule Unit
modl
case Maybe ModuleInfo
mb_mod_info of
Maybe ModuleInfo
Nothing -> GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError ([Char]
"unknown module: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
ModuleName -> [Char]
GHC.moduleNameString (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName GenModule Unit
modl)))
Just ModuleInfo
mod_info -> do
let names :: [Name]
names
| Bool
exports_only = ModuleInfo -> [Name]
GHC.modInfoExports ModuleInfo
mod_info
| Bool
otherwise = ModuleInfo -> Maybe [Name]
GHC.modInfoTopLevelScope ModuleInfo
mod_info
Maybe [Name] -> [Name] -> [Name]
forall a. Maybe a -> a -> a
`orElse` []
sorted_names :: [Name]
sorted_names = [Name] -> [Name]
loc_sort [Name]
local [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name] -> [Name]
occ_sort [Name]
external
where
([Name]
local,[Name]
external) = Bool -> ([Name], [Name]) -> ([Name], [Name])
forall a. HasCallStack => Bool -> a -> a
assert ((Name -> Bool) -> [Name] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Name -> Bool
isExternalName [Name]
names) (([Name], [Name]) -> ([Name], [Name]))
-> ([Name], [Name]) -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$
(Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((GenModule Unit -> GenModule Unit -> Bool
forall a. Eq a => a -> a -> Bool
==GenModule Unit
modl) (GenModule Unit -> Bool)
-> (Name -> GenModule Unit) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
nameModule) [Name]
names
occ_sort :: [Name] -> [Name]
occ_sort = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OccName -> OccName -> Ordering)
-> (Name -> OccName) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> OccName
nameOccName)
loc_sort :: [Name] -> [Name]
loc_sort [Name]
ns
| Name
n:[Name]
_ <- [Name]
ns, SrcSpan -> Bool
isGoodSrcSpan (Name -> SrcSpan
nameSrcSpan Name
n)
= (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (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
nameSrcSpan) [Name]
ns
| Bool
otherwise
= [Name] -> [Name]
occ_sort [Name]
ns
[Maybe TyThing]
mb_things <- (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)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName [Name]
sorted_names
let filtered_things :: [TyThing]
filtered_things = (TyThing -> TyThing) -> [TyThing] -> [TyThing]
forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (\TyThing
t -> TyThing
t) ([Maybe TyThing] -> [TyThing]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TyThing]
mb_things)
GlobalRdrEnv
rdr_env <- m GlobalRdrEnv
forall (m :: Type -> Type). GhcMonad m => m GlobalRdrEnv
GHC.getGRE
let things :: [TyThing]
things | Bool
bang = [Maybe TyThing] -> [TyThing]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TyThing]
mb_things
| Bool
otherwise = [TyThing]
filtered_things
pretty :: TyThing -> SDoc
pretty | Bool
bang = ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
showToHeader
| Bool
otherwise = ShowSub -> TyThing -> SDoc
pprTyThingInContext ShowSub
showToHeader
labels :: [Maybe [ModuleName]] -> doc
labels [] = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-- not currently imported"
labels [Maybe [ModuleName]]
l = [Char] -> doc
forall doc. IsLine doc => [Char] -> doc
text ([Char] -> doc) -> [Char] -> doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Maybe [ModuleName] -> [Char]) -> [Maybe [ModuleName]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Maybe [ModuleName] -> [Char]
qualifier [Maybe [ModuleName]]
l
qualifier :: Maybe [ModuleName] -> String
qualifier :: Maybe [ModuleName] -> [Char]
qualifier = [Char] -> ([ModuleName] -> [Char]) -> Maybe [ModuleName] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"-- defined locally"
(([Char]
"-- imported via "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char])
-> ([ModuleName] -> [Char]) -> [ModuleName] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", "
([[Char]] -> [Char])
-> ([ModuleName] -> [[Char]]) -> [ModuleName] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> [Char]
GHC.moduleNameString)
importInfo :: Name -> [Maybe [ModuleName]]
importInfo = GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
RdrName.getGRE_NameQualifier_maybes GlobalRdrEnv
rdr_env
modNames :: [[Maybe [ModuleName]]]
modNames :: [[Maybe [ModuleName]]]
modNames = (TyThing -> [Maybe [ModuleName]])
-> [TyThing] -> [[Maybe [ModuleName]]]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> [Maybe [ModuleName]]
importInfo (Name -> [Maybe [ModuleName]])
-> (TyThing -> Name) -> TyThing -> [Maybe [ModuleName]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> Name
forall a. NamedThing a => a -> Name
GHC.getName) [TyThing]
things
annotate :: [([Maybe [ModuleName]], b)] -> [b]
annotate [([Maybe [ModuleName]], b)]
mts = (([Maybe [ModuleName]], [b]) -> [b])
-> [([Maybe [ModuleName]], [b])] -> [b]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\([Maybe [ModuleName]]
m,[b]
ts)->[Maybe [ModuleName]] -> b
forall {doc}. IsLine doc => [Maybe [ModuleName]] -> doc
labels [Maybe [ModuleName]]
mb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ts)
([([Maybe [ModuleName]], [b])] -> [b])
-> [([Maybe [ModuleName]], [b])] -> [b]
forall a b. (a -> b) -> a -> b
$ (([Maybe [ModuleName]], [b])
-> ([Maybe [ModuleName]], [b]) -> Ordering)
-> [([Maybe [ModuleName]], [b])] -> [([Maybe [ModuleName]], [b])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([Maybe [ModuleName]], [b])
-> ([Maybe [ModuleName]], [b]) -> Ordering
forall {b}.
([Maybe [ModuleName]], b) -> ([Maybe [ModuleName]], b) -> Ordering
cmpQualifiers ([([Maybe [ModuleName]], [b])] -> [([Maybe [ModuleName]], [b])])
-> [([Maybe [ModuleName]], [b])] -> [([Maybe [ModuleName]], [b])]
forall a b. (a -> b) -> a -> b
$ [([Maybe [ModuleName]], b)] -> [([Maybe [ModuleName]], [b])]
forall {a} {b}. Eq a => [(a, b)] -> [(a, [b])]
grp [([Maybe [ModuleName]], b)]
mts
where cmpQualifiers :: ([Maybe [ModuleName]], b) -> ([Maybe [ModuleName]], b) -> Ordering
cmpQualifiers =
[Maybe [[Char]]] -> [Maybe [[Char]]] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Maybe [[Char]]] -> [Maybe [[Char]]] -> Ordering)
-> (([Maybe [ModuleName]], b) -> [Maybe [[Char]]])
-> ([Maybe [ModuleName]], b)
-> ([Maybe [ModuleName]], b)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Maybe [ModuleName] -> Maybe [[Char]])
-> [Maybe [ModuleName]] -> [Maybe [[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (([ModuleName] -> [[Char]]) -> Maybe [ModuleName] -> Maybe [[Char]]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> [Char]
unpackFS (FastString -> [Char])
-> (ModuleName -> FastString) -> ModuleName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
moduleNameFS))) ([Maybe [ModuleName]] -> [Maybe [[Char]]])
-> (([Maybe [ModuleName]], b) -> [Maybe [ModuleName]])
-> ([Maybe [ModuleName]], b)
-> [Maybe [[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe [ModuleName]], b) -> [Maybe [ModuleName]]
forall a b. (a, b) -> a
fst)
grp :: [(a, b)] -> [(a, [b])]
grp [] = []
grp mts :: [(a, b)]
mts@((a
m,b
_):[(a, b)]
_) = (a
m,((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
g) (a, [b]) -> [(a, [b])] -> [(a, [b])]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, [b])]
grp [(a, b)]
ng
where ([(a, b)]
g,[(a, b)]
ng) = ((a, b) -> Bool) -> [(a, b)] -> ([(a, b)], [(a, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
m)(a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
mts
let prettyThings, prettyThings' :: [SDoc]
prettyThings :: [SDoc]
prettyThings = (TyThing -> SDoc) -> [TyThing] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> SDoc
pretty [TyThing]
things
prettyThings' :: [SDoc]
prettyThings' | Bool
bang = [([Maybe [ModuleName]], SDoc)] -> [SDoc]
forall {b}. IsLine b => [([Maybe [ModuleName]], b)] -> [b]
annotate ([([Maybe [ModuleName]], SDoc)] -> [SDoc])
-> [([Maybe [ModuleName]], SDoc)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [[Maybe [ModuleName]]] -> [SDoc] -> [([Maybe [ModuleName]], SDoc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Maybe [ModuleName]]]
modNames [SDoc]
prettyThings
| Bool
otherwise = [SDoc]
prettyThings
[Char]
rendered_things <- SDoc -> m [Char]
forall (m :: Type -> Type). GhcMonad m => SDoc -> m [Char]
showSDocForUser' ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
prettyThings')
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
rendered_things
moduleCmd :: GhciMonad m => String -> m ()
moduleCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
moduleCmd [Char]
str
| ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all [Char] -> Bool
sensible [[Char]]
strs = m ()
cmd
| Bool
otherwise = GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: :module [+/-] [*]M1 ... [*]Mn")
where
(m ()
cmd, [[Char]]
strs) =
case [Char]
str of
Char
'+':[Char]
stuff -> ([ModuleName] -> [ModuleName] -> m ())
-> [Char] -> (m (), [[Char]])
forall {a}.
([ModuleName] -> [ModuleName] -> a) -> [Char] -> (a, [[Char]])
rest [ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext [Char]
stuff
Char
'-':[Char]
stuff -> ([ModuleName] -> [ModuleName] -> m ())
-> [Char] -> (m (), [[Char]])
forall {a}.
([ModuleName] -> [ModuleName] -> a) -> [Char] -> (a, [[Char]])
rest [ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
remModulesFromContext [Char]
stuff
[Char]
stuff -> ([ModuleName] -> [ModuleName] -> m ())
-> [Char] -> (m (), [[Char]])
forall {a}.
([ModuleName] -> [ModuleName] -> a) -> [Char] -> (a, [[Char]])
rest [ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
setContext [Char]
stuff
rest :: ([ModuleName] -> [ModuleName] -> a) -> [Char] -> (a, [[Char]])
rest [ModuleName] -> [ModuleName] -> a
op [Char]
stuff = ([ModuleName] -> [ModuleName] -> a
op [ModuleName]
as [ModuleName]
bs, [[Char]]
stuffs)
where ([ModuleName]
as,[ModuleName]
bs) = ([Char] -> Either ModuleName ModuleName)
-> [[Char]] -> ([ModuleName], [ModuleName])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith [Char] -> Either ModuleName ModuleName
starred [[Char]]
stuffs
stuffs :: [[Char]]
stuffs = [Char] -> [[Char]]
words [Char]
stuff
sensible :: [Char] -> Bool
sensible (Char
'*':[Char]
m) = [Char] -> Bool
looksLikeModuleName [Char]
m
sensible [Char]
m = [Char] -> Bool
looksLikeModuleName [Char]
m
starred :: [Char] -> Either ModuleName ModuleName
starred (Char
'*':[Char]
m) = ModuleName -> Either ModuleName ModuleName
forall a b. a -> Either a b
Left ([Char] -> ModuleName
GHC.mkModuleName [Char]
m)
starred [Char]
m = ModuleName -> Either ModuleName ModuleName
forall a b. b -> Either a b
Right ([Char] -> ModuleName
GHC.mkModuleName [Char]
m)
addModulesToContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
addModulesToContext :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext [ModuleName]
starred [ModuleName]
unstarred = m () -> m ()
forall (m :: Type -> Type) a. GhciMonad m => m a -> m a
restoreContextOnFailure (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext_ [ModuleName]
starred [ModuleName]
unstarred
addModulesToContext_ :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
addModulesToContext_ :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext_ [ModuleName]
starred [ModuleName]
unstarred = do
(InteractiveImport -> m ()) -> [InteractiveImport] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ InteractiveImport -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
InteractiveImport -> m ()
addII ((ModuleName -> InteractiveImport)
-> [ModuleName] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> InteractiveImport
mkIIModule [ModuleName]
starred [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> InteractiveImport)
-> [ModuleName] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> InteractiveImport
mkIIDecl [ModuleName]
unstarred)
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState
remModulesFromContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
remModulesFromContext :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
remModulesFromContext [ModuleName]
starred [ModuleName]
unstarred = do
(ModuleName -> m ()) -> [ModuleName] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModuleName -> m ()
forall (m :: Type -> Type). GhciMonad m => ModuleName -> m ()
rm ([ModuleName]
starred [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
unstarred)
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState
where
rm :: GhciMonad m => ModuleName -> m ()
rm :: forall (m :: Type -> Type). GhciMonad m => ModuleName -> m ()
rm ModuleName
str = do
ModuleName
m <- GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName)
-> m (GenModule Unit) -> m ModuleName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ModuleName
str
let filt :: [InteractiveImport] -> [InteractiveImport]
filt = (InteractiveImport -> Bool)
-> [InteractiveImport] -> [InteractiveImport]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ModuleName
m (ModuleName -> Bool)
-> (InteractiveImport -> ModuleName) -> InteractiveImport -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveImport -> ModuleName
iiModuleName)
(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 { remembered_ctx = filt (remembered_ctx st)
, transient_ctx = filt (transient_ctx st) }
setContext :: GhciMonad m => [ModuleName] -> [ModuleName] -> m ()
setContext :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
setContext [ModuleName]
starred [ModuleName]
unstarred = m () -> m ()
forall (m :: Type -> Type) a. GhciMonad m => m a -> m a
restoreContextOnFailure (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(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 { remembered_ctx = [], transient_ctx = [] }
[ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext_ [ModuleName]
starred [ModuleName]
unstarred
addImportToContext :: GhciMonad m => ImportDecl GhcPs -> m ()
addImportToContext :: forall (m :: Type -> Type). GhciMonad m => ImportDecl GhcPs -> m ()
addImportToContext ImportDecl GhcPs
idecl = m () -> m ()
forall (m :: Type -> Type) a. GhciMonad m => m a -> m a
restoreContextOnFailure (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
InteractiveImport -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
InteractiveImport -> m ()
addII (ImportDecl GhcPs -> InteractiveImport
IIDecl ImportDecl GhcPs
idecl)
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState
addII :: GhciMonad m => InteractiveImport -> m ()
addII :: forall (m :: Type -> Type).
GhciMonad m =>
InteractiveImport -> m ()
addII InteractiveImport
iidecl = do
InteractiveImport -> m ()
forall (m :: Type -> Type). GhcMonad m => InteractiveImport -> m ()
checkAdd InteractiveImport
iidecl
(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 { remembered_ctx = addNotSubsumed iidecl (remembered_ctx st)
, transient_ctx = filter (not . (iidecl `iiSubsumes`))
(transient_ctx st)
}
restoreContextOnFailure :: GhciMonad m => m a -> m a
restoreContextOnFailure :: forall (m :: Type -> Type) a. GhciMonad m => m a -> m a
restoreContextOnFailure m a
do_this = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let rc :: [InteractiveImport]
rc = GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st; tc :: [InteractiveImport]
tc = GHCiState -> [InteractiveImport]
transient_ctx GHCiState
st
m a
do_this m a -> m () -> m a
forall (m :: Type -> Type) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`MC.onException` ((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' { remembered_ctx = rc, transient_ctx = tc })
checkAdd :: GHC.GhcMonad m => InteractiveImport -> m ()
checkAdd :: forall (m :: Type -> Type). GhcMonad m => InteractiveImport -> m ()
checkAdd InteractiveImport
ii = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let safe :: Bool
safe = DynFlags -> Bool
safeLanguageOn DynFlags
dflags
case InteractiveImport
ii of
IIModule ModuleName
modname
| Bool
safe -> GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ()) -> GhcException -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError [Char]
"can't use * imports with Safe Haskell"
| Bool
otherwise -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
wantInterpretedModuleName ModuleName
modname m (GenModule Unit) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
IIDecl ImportDecl GhcPs
d -> do
let modname :: ModuleName
modname = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d)
PkgQual
pkgqual <- ModuleName -> RawPkgQual -> m PkgQual
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> RawPkgQual -> m PkgQual
GHC.renameRawPkgQualM ModuleName
modname (ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
d)
GenModule Unit
m <- PkgQual -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
PkgQual -> ModuleName -> m (GenModule Unit)
GHC.lookupQualifiedModule PkgQual
pkgqual ModuleName
modname
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
safe (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
t <- GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.isModuleTrusted GenModule Unit
m
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
t) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ()) -> GhcException -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
ProgramError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$ [Char]
""
setGHCContextFromGHCiState :: GhciMonad m => m ()
setGHCContextFromGHCiState :: forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
[InteractiveImport]
iidecls <- (InteractiveImport -> m Bool)
-> [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (m () -> m Bool
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m Bool
tryBool(m () -> m Bool)
-> (InteractiveImport -> m ()) -> InteractiveImport -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.InteractiveImport -> m ()
forall (m :: Type -> Type). GhcMonad m => InteractiveImport -> m ()
checkAdd) (GHCiState -> [InteractiveImport]
transient_ctx GHCiState
st [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st)
[InteractiveImport]
prel_iidecls <- [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type).
GhciMonad m =>
[InteractiveImport] -> m [InteractiveImport]
getImplicitPreludeImports [InteractiveImport]
iidecls
[InteractiveImport]
valid_prel_iidecls <- (InteractiveImport -> m Bool)
-> [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (m () -> m Bool
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m Bool
tryBool (m () -> m Bool)
-> (InteractiveImport -> m ()) -> InteractiveImport -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveImport -> m ()
forall (m :: Type -> Type). GhcMonad m => InteractiveImport -> m ()
checkAdd) [InteractiveImport]
prel_iidecls
[InteractiveImport]
extra_imports <- (InteractiveImport -> m Bool)
-> [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (m () -> m Bool
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m Bool
tryBool (m () -> m Bool)
-> (InteractiveImport -> m ()) -> InteractiveImport -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveImport -> m ()
forall (m :: Type -> Type). GhcMonad m => InteractiveImport -> m ()
checkAdd) ((ImportDecl GhcPs -> InteractiveImport)
-> [ImportDecl GhcPs] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> InteractiveImport
IIDecl (GHCiState -> [ImportDecl GhcPs]
extra_imports GHCiState
st))
[InteractiveImport] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
[InteractiveImport] -> m ()
GHC.setContext ([InteractiveImport] -> m ()) -> [InteractiveImport] -> m ()
forall a b. (a -> b) -> a -> b
$ [InteractiveImport]
iidecls [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ [InteractiveImport]
extra_imports [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ [InteractiveImport]
valid_prel_iidecls
getImplicitPreludeImports :: GhciMonad m
=> [InteractiveImport] -> m [InteractiveImport]
getImplicitPreludeImports :: forall (m :: Type -> Type).
GhciMonad m =>
[InteractiveImport] -> m [InteractiveImport]
getImplicitPreludeImports [InteractiveImport]
iidecls = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let prel_iidecls :: [InteractiveImport]
prel_iidecls =
if Bool -> Bool
not ((InteractiveImport -> Bool) -> [InteractiveImport] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any InteractiveImport -> Bool
isIIModule [InteractiveImport]
iidecls)
then [ ImportDecl GhcPs -> InteractiveImport
IIDecl ImportDecl GhcPs
imp
| ImportDecl GhcPs
imp <- GHCiState -> [ImportDecl GhcPs]
prelude_imports GHCiState
st
, Bool -> Bool
not ((InteractiveImport -> Bool) -> [InteractiveImport] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (ImportDecl GhcPs -> InteractiveImport -> Bool
sameImpModule ImportDecl GhcPs
imp) [InteractiveImport]
iidecls) ]
else []
[InteractiveImport] -> m [InteractiveImport]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [InteractiveImport]
prel_iidecls
mkIIModule :: ModuleName -> InteractiveImport
mkIIModule :: ModuleName -> InteractiveImport
mkIIModule = ModuleName -> InteractiveImport
IIModule
mkIIDecl :: ModuleName -> InteractiveImport
mkIIDecl :: ModuleName -> InteractiveImport
mkIIDecl = ImportDecl GhcPs -> InteractiveImport
IIDecl (ImportDecl GhcPs -> InteractiveImport)
-> (ModuleName -> ImportDecl GhcPs)
-> ModuleName
-> InteractiveImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> ImportDecl GhcPs
simpleImportDecl
iiModules :: [InteractiveImport] -> [ModuleName]
iiModules :: [InteractiveImport] -> [ModuleName]
iiModules [InteractiveImport]
is = [ModuleName
m | IIModule ModuleName
m <- [InteractiveImport]
is]
isIIModule :: InteractiveImport -> Bool
isIIModule :: InteractiveImport -> Bool
isIIModule (IIModule ModuleName
_) = Bool
True
isIIModule InteractiveImport
_ = Bool
False
iiModuleName :: InteractiveImport -> ModuleName
iiModuleName :: InteractiveImport -> ModuleName
iiModuleName (IIModule ModuleName
m) = ModuleName
m
iiModuleName (IIDecl ImportDecl GhcPs
d) = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d)
preludeModuleName :: ModuleName
preludeModuleName :: ModuleName
preludeModuleName = [Char] -> ModuleName
GHC.mkModuleName [Char]
"Clash.Prelude"
sameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool
sameImpModule :: ImportDecl GhcPs -> InteractiveImport -> Bool
sameImpModule ImportDecl GhcPs
_ (IIModule ModuleName
_) = Bool
False
sameImpModule ImportDecl GhcPs
imp (IIDecl ImportDecl GhcPs
d) = GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
imp)
addNotSubsumed :: InteractiveImport
-> [InteractiveImport] -> [InteractiveImport]
addNotSubsumed :: InteractiveImport -> [InteractiveImport] -> [InteractiveImport]
addNotSubsumed InteractiveImport
i [InteractiveImport]
is
| (InteractiveImport -> Bool) -> [InteractiveImport] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (InteractiveImport -> InteractiveImport -> Bool
`iiSubsumes` InteractiveImport
i) [InteractiveImport]
is = [InteractiveImport]
is
| Bool
otherwise = InteractiveImport
i InteractiveImport -> [InteractiveImport] -> [InteractiveImport]
forall a. a -> [a] -> [a]
: (InteractiveImport -> Bool)
-> [InteractiveImport] -> [InteractiveImport]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (InteractiveImport -> Bool) -> InteractiveImport -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InteractiveImport
i InteractiveImport -> InteractiveImport -> Bool
`iiSubsumes`)) [InteractiveImport]
is
filterSubsumed :: [InteractiveImport] -> [InteractiveImport]
-> [InteractiveImport]
filterSubsumed :: [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
filterSubsumed [InteractiveImport]
is [InteractiveImport]
js = (InteractiveImport -> Bool)
-> [InteractiveImport] -> [InteractiveImport]
forall a. (a -> Bool) -> [a] -> [a]
filter (\InteractiveImport
j -> Bool -> Bool
not ((InteractiveImport -> Bool) -> [InteractiveImport] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (InteractiveImport -> InteractiveImport -> Bool
`iiSubsumes` InteractiveImport
j) [InteractiveImport]
is)) [InteractiveImport]
js
iiSubsumes :: InteractiveImport -> InteractiveImport -> Bool
iiSubsumes :: InteractiveImport -> InteractiveImport -> Bool
iiSubsumes (IIModule ModuleName
m1) (IIModule ModuleName
m2) = ModuleName
m1ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
==ModuleName
m2
iiSubsumes (IIDecl ImportDecl GhcPs
d1) (IIDecl ImportDecl GhcPs
d2)
= GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d1) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
d2)
Bool -> Bool -> Bool
&& ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
d1 Maybe (GenLocated SrcSpanAnnA ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
d2
Bool -> Bool -> Bool
&& (Bool -> Bool
not (ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
d1)) Bool -> Bool -> Bool
|| ImportDeclQualifiedStyle -> Bool
isImportDeclQualified (ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
d2))
Bool -> Bool -> Bool
&& (ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
d1 Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall {a} {l}.
(Eq a, Eq l) =>
Maybe (ImportListInterpretation, GenLocated l [a])
-> Maybe (ImportListInterpretation, GenLocated l [a]) -> Bool
`hidingSubsumes` ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
d2)
where
Maybe (ImportListInterpretation, GenLocated l [a])
_ hidingSubsumes :: Maybe (ImportListInterpretation, GenLocated l [a])
-> Maybe (ImportListInterpretation, GenLocated l [a]) -> Bool
`hidingSubsumes` Just (ImportListInterpretation
Exactly,L l
_ []) = Bool
True
Just (ImportListInterpretation
Exactly, L l
_ [a]
xs) `hidingSubsumes` Just (ImportListInterpretation
Exactly,L l
_ [a]
ys)
= (a -> Bool) -> [a] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [a]
xs) [a]
ys
Maybe (ImportListInterpretation, GenLocated l [a])
h1 `hidingSubsumes` Maybe (ImportListInterpretation, GenLocated l [a])
h2 = Maybe (ImportListInterpretation, GenLocated l [a])
h1 Maybe (ImportListInterpretation, GenLocated l [a])
-> Maybe (ImportListInterpretation, GenLocated l [a]) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (ImportListInterpretation, GenLocated l [a])
h2
iiSubsumes InteractiveImport
_ InteractiveImport
_ = Bool
False
setCmd :: GhciMonad m => String -> m ()
setCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setCmd [Char]
"" = Bool -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
showOptions Bool
False
setCmd [Char]
"-a" = Bool -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
showOptions Bool
True
setCmd [Char]
str
= case [Char] -> Either [Char] ([Char], [Char])
getCmd [Char]
str of
Right ([Char]
"args", [Char]
rest) ->
case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
rest of
Left [Char]
err -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
args -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setArgs [[Char]]
args
Right ([Char]
"prog", [Char]
rest) ->
case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
rest of
Right [[Char]
prog] -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setProg [Char]
prog
Either [Char] [[Char]]
_ -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"syntax: :set prog <progname>")
Right ([Char]
"prompt", [Char]
rest) ->
(PromptFunction -> m ()) -> [Char] -> [Char] -> m ()
forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> [Char] -> m ()
setPromptString PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPrompt ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
[Char]
"syntax: set prompt <string>"
Right ([Char]
"prompt-function", [Char]
rest) ->
(PromptFunction -> m ()) -> [Char] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setPromptFunc PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPrompt ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest
Right ([Char]
"prompt-cont", [Char]
rest) ->
(PromptFunction -> m ()) -> [Char] -> [Char] -> m ()
forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> [Char] -> m ()
setPromptString PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPromptCont ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
[Char]
"syntax: :set prompt-cont <string>"
Right ([Char]
"prompt-cont-function", [Char]
rest) ->
(PromptFunction -> m ()) -> [Char] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setPromptFunc PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPromptCont ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest
Right ([Char]
"editor", [Char]
rest) -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setEditor ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest
Right ([Char]
"stop", [Char]
rest) -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setStop ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest
Right ([Char]
"local-config", [Char]
rest) ->
[Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setLocalConfigBehaviour ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest
Either [Char] ([Char], [Char])
_ -> case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
str of
Left [Char]
err -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
wds -> () () -> m CmdExecOutcome -> m ()
forall a b. a -> m b -> m a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ ([[Char]] -> m ()) -> [[Char]] -> m CmdExecOutcome
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> m ()) -> a -> m CmdExecOutcome
keepGoing' [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setOptions [[Char]]
wds
setiCmd :: GhciMonad m => String -> m ()
setiCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setiCmd [Char]
"" = m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags m DynFlags -> (DynFlags -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (DynFlags -> IO ()) -> DynFlags -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DynFlags -> IO ()
showDynFlags Bool
False
setiCmd [Char]
"-a" = m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags m DynFlags -> (DynFlags -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (DynFlags -> IO ()) -> DynFlags -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DynFlags -> IO ()
showDynFlags Bool
True
setiCmd [Char]
str =
case [Char] -> Either [Char] [[Char]]
toArgsNoLoc [Char]
str of
Left [Char]
err -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
wds -> Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
newDynFlags Bool
True [[Char]]
wds
showOptions :: GhciMonad m => Bool -> m ()
showOptions :: forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
showOptions Bool
show_all
= do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let opts :: [GHCiOption]
opts = GHCiState -> [GHCiOption]
options GHCiState
st
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn (DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"options currently set: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
if [GHCiOption] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [GHCiOption]
opts
then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"none."
else [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((GHCiOption -> SDoc) -> [GHCiOption] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\GHCiOption
o -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'+' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (GHCiOption -> [Char]
optToStr GHCiOption
o)) [GHCiOption]
opts)
))
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> DynFlags -> IO ()
showDynFlags Bool
show_all DynFlags
dflags
showDynFlags :: Bool -> DynFlags -> IO ()
showDynFlags :: Bool -> DynFlags -> IO ()
showDynFlags Bool
show_all DynFlags
dflags = do
Bool -> DynFlags -> IO ()
showLanguages' Bool
show_all DynFlags
dflags
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHCi-specific dynamic flag settings:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FlagSpec GeneralFlag -> SDoc) -> [FlagSpec GeneralFlag] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
-> [Char]
-> (GeneralFlag -> DynFlags -> Bool)
-> FlagSpec GeneralFlag
-> SDoc
forall flag.
[Char]
-> [Char] -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting [Char]
"-f" [Char]
"-fno-" GeneralFlag -> DynFlags -> Bool
gopt) [FlagSpec GeneralFlag]
ghciFlags))
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"other dynamic, non-language, flag settings:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FlagSpec GeneralFlag -> SDoc) -> [FlagSpec GeneralFlag] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
-> [Char]
-> (GeneralFlag -> DynFlags -> Bool)
-> FlagSpec GeneralFlag
-> SDoc
forall flag.
[Char]
-> [Char] -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting [Char]
"-f" [Char]
"-fno-" GeneralFlag -> DynFlags -> Bool
gopt) [FlagSpec GeneralFlag]
others))
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"warning settings:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FlagSpec WarningFlag -> SDoc) -> [FlagSpec WarningFlag] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
-> [Char]
-> (WarningFlag -> DynFlags -> Bool)
-> FlagSpec WarningFlag
-> SDoc
forall flag.
[Char]
-> [Char] -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting [Char]
"-W" [Char]
"-Wno-" WarningFlag -> DynFlags -> Bool
wopt) [FlagSpec WarningFlag]
DynFlags.wWarningFlags))
where
setting :: String -> String -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting :: forall flag.
[Char]
-> [Char] -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting [Char]
prefix [Char]
noPrefix flag -> DynFlags -> Bool
test FlagSpec flag
flag
| Bool
quiet = SDoc
forall doc. IsOutput doc => doc
empty
| Bool
is_on = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
prefix SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
name
| Bool
otherwise = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
noPrefix SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
name
where name :: [Char]
name = FlagSpec flag -> [Char]
forall flag. FlagSpec flag -> [Char]
flagSpecName FlagSpec flag
flag
f :: flag
f = FlagSpec flag -> flag
forall flag. FlagSpec flag -> flag
flagSpecFlag FlagSpec flag
flag
is_on :: Bool
is_on = flag -> DynFlags -> Bool
test flag
f DynFlags
dflags
quiet :: Bool
quiet = Bool -> Bool
not Bool
show_all Bool -> Bool -> Bool
&& flag -> DynFlags -> Bool
test flag
f DynFlags
default_dflags Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
is_on
default_dflags :: DynFlags
default_dflags = Settings -> DynFlags
defaultDynFlags (DynFlags -> Settings
settings DynFlags
dflags)
([FlagSpec GeneralFlag]
ghciFlags,[FlagSpec GeneralFlag]
others) = (FlagSpec GeneralFlag -> Bool)
-> [FlagSpec GeneralFlag]
-> ([FlagSpec GeneralFlag], [FlagSpec GeneralFlag])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\FlagSpec GeneralFlag
f -> FlagSpec GeneralFlag -> GeneralFlag
forall flag. FlagSpec flag -> flag
flagSpecFlag FlagSpec GeneralFlag
f GeneralFlag -> [GeneralFlag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [GeneralFlag]
flgs)
[FlagSpec GeneralFlag]
DynFlags.fFlags
flgs :: [GeneralFlag]
flgs = [ GeneralFlag
Opt_PrintExplicitForalls
, GeneralFlag
Opt_PrintExplicitKinds
, GeneralFlag
Opt_PrintUnicodeSyntax
, GeneralFlag
Opt_PrintBindResult
, GeneralFlag
Opt_BreakOnException
, GeneralFlag
Opt_BreakOnError
, GeneralFlag
Opt_PrintEvldWithShow
]
setArgs, setOptions :: GhciMonad m => [String] -> m ()
setProg, setEditor, setStop :: GhciMonad m => String -> m ()
setLocalConfigBehaviour :: GhciMonad m => String -> m ()
setArgs :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setArgs [[Char]]
args = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
ForeignHValue
wrapper <- [Char] -> [[Char]] -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper (GHCiState -> [Char]
progname GHCiState
st) [[Char]]
args
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st { GhciMonad.args = args, evalWrapper = wrapper }
setProg :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setProg [Char]
prog = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
ForeignHValue
wrapper <- [Char] -> [[Char]] -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper [Char]
prog (GHCiState -> [[Char]]
GhciMonad.args GHCiState
st)
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st { progname = prog, evalWrapper = wrapper }
setEditor :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setEditor [Char]
cmd = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { editor = cmd })
setLocalConfigBehaviour :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setLocalConfigBehaviour [Char]
s
| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"source" =
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { localConfig = SourceLocalConfig })
| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"ignore" =
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { localConfig = IgnoreLocalConfig })
| Bool
otherwise = GhcException -> m ()
forall a. GhcException -> a
throwGhcException
([Char] -> GhcException
CmdLineError [Char]
"syntax: :set local-config { source | ignore }")
setStop :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setStop str :: [Char]
str@(Char
c:[Char]
_) | Char -> Bool
isDigit Char
c
= do let ([Char]
nm_str,[Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isDigit) [Char]
str
nm :: Int
nm = [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
nm_str
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let old_breaks :: IntMap BreakLocation
old_breaks = GHCiState -> IntMap BreakLocation
breaks GHCiState
st
case Int -> IntMap BreakLocation -> Maybe BreakLocation
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
nm IntMap BreakLocation
old_breaks of
Maybe BreakLocation
Nothing -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nm SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not exist")
Just BreakLocation
loc -> do
let new_breaks :: IntMap BreakLocation
new_breaks = Int
-> BreakLocation -> IntMap BreakLocation -> IntMap BreakLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
nm
BreakLocation
loc { onBreakCmd = dropWhile isSpace rest }
IntMap BreakLocation
old_breaks
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ breaks = new_breaks }
setStop [Char]
cmd = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { stop = cmd })
setPrompt :: GhciMonad m => PromptFunction -> m ()
setPrompt :: forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPrompt PromptFunction
v = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st {prompt = v})
setPromptCont :: GhciMonad m => PromptFunction -> m ()
setPromptCont :: forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPromptCont PromptFunction
v = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st {prompt_cont = v})
setPromptFunc :: GHC.GhcMonad m => (PromptFunction -> m ()) -> String -> m ()
setPromptFunc :: forall (m :: Type -> Type).
GhcMonad m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setPromptFunc PromptFunction -> m ()
fSetPrompt [Char]
s = do
let exprStr :: [Char]
exprStr = [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") :: [String] -> Int -> IO String"
(HValue Any
funValue) <- [Char] -> m HValue
forall (m :: Type -> Type). GhcMonad m => [Char] -> m HValue
GHC.compileExpr [Char]
exprStr
PromptFunction -> m ()
fSetPrompt (([[Char]] -> Int -> IO [Char]) -> PromptFunction
convertToPromptFunction (([[Char]] -> Int -> IO [Char]) -> PromptFunction)
-> ([[Char]] -> Int -> IO [Char]) -> PromptFunction
forall a b. (a -> b) -> a -> b
$ Any -> [[Char]] -> Int -> IO [Char]
forall a b. a -> b
unsafeCoerce Any
funValue)
where
convertToPromptFunction :: ([String] -> Int -> IO String)
-> PromptFunction
convertToPromptFunction :: ([[Char]] -> Int -> IO [Char]) -> PromptFunction
convertToPromptFunction [[Char]] -> Int -> IO [Char]
func = (\[[Char]]
mods Int
line -> IO SDoc -> GHCi SDoc
forall a. IO a -> GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO SDoc -> GHCi SDoc) -> IO SDoc -> GHCi SDoc
forall a b. (a -> b) -> a -> b
$
([Char] -> SDoc) -> IO [Char] -> IO SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([[Char]] -> Int -> IO [Char]
func [[Char]]
mods Int
line))
setPromptString :: MonadIO m
=> (PromptFunction -> m ()) -> String -> String -> m ()
setPromptString :: forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> [Char] -> m ()
setPromptString PromptFunction -> m ()
fSetPrompt [Char]
value [Char]
err = do
if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
value
then IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
err
else case [Char]
value of
(Char
'\"':[Char]
_) ->
case ReadS [Char]
forall a. Read a => ReadS a
reads [Char]
value of
[([Char]
value', [Char]
xs)] | (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
xs ->
(PromptFunction -> m ()) -> [Char] -> m ()
forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setParsedPromptString PromptFunction -> m ()
fSetPrompt [Char]
value'
[([Char], [Char])]
_ -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
[Char]
"Can't parse prompt string. Use Haskell syntax."
[Char]
_ ->
(PromptFunction -> m ()) -> [Char] -> m ()
forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setParsedPromptString PromptFunction -> m ()
fSetPrompt [Char]
value
setParsedPromptString :: MonadIO m
=> (PromptFunction -> m ()) -> String -> m ()
setParsedPromptString :: forall (m :: Type -> Type).
MonadIO m =>
(PromptFunction -> m ()) -> [Char] -> m ()
setParsedPromptString PromptFunction -> m ()
fSetPrompt [Char]
s = do
case ([Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
s) of
Just [Char]
err ->
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
Maybe [Char]
Nothing ->
PromptFunction -> m ()
fSetPrompt (PromptFunction -> m ()) -> PromptFunction -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
s
setOptions :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setOptions [[Char]]
wds =
do
let ([[Char]]
plus_opts, [[Char]]
minus_opts) = ([Char] -> Either [Char] [Char])
-> [[Char]] -> ([[Char]], [[Char]])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith [Char] -> Either [Char] [Char]
isPlus [[Char]]
wds
([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setOpt [[Char]]
plus_opts
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
minus_opts)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
newDynFlags Bool
False [[Char]]
minus_opts
newDynFlags :: GhciMonad m => Bool -> [String] -> m ()
newDynFlags :: forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
newDynFlags Bool
interactive_only [[Char]]
minus_opts = do
let lopts :: [Located [Char]]
lopts = ([Char] -> Located [Char]) -> [[Char]] -> [Located [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Located [Char]
forall e. e -> Located e
noLoc [[Char]]
minus_opts
Logger
logger <- m Logger
forall (m :: Type -> Type). HasLogger m => m Logger
getLogger
DynFlags
idflags0 <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
(DynFlags
idflags1, [Located [Char]]
leftovers, [Warn]
warns) <- DynFlags
-> [Located [Char]] -> m (DynFlags, [Located [Char]], [Warn])
forall (m :: Type -> Type).
MonadIO m =>
DynFlags
-> [Located [Char]] -> m (DynFlags, [Located [Char]], [Warn])
DynFlags.parseDynamicFlagsCmdLine DynFlags
idflags0 [Located [Char]]
lopts
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger -> GhcMessageOpts -> DiagOpts -> [Warn] -> IO ()
handleFlagWarnings Logger
logger (DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
idflags1) (DynFlags -> DiagOpts
initDiagOpts DynFlags
idflags1) [Warn]
warns
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Located [Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Located [Char]]
leftovers)
(GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ())
-> ([Char] -> GhcException) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GhcException
CmdLineError
([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Some flags have not been recognized: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([[Char]] -> [Char]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Located [Char] -> [Char]) -> [Located [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Located [Char] -> [Char]
forall l e. GenLocated l e -> e
unLoc [Located [Char]]
leftovers))
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool
interactive_only Bool -> Bool -> Bool
&& DynFlags -> DynFlags -> Bool
packageFlagsChanged DynFlags
idflags1 DynFlags
idflags0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"cannot set package flags with :seti; use :set"
DynFlags -> m ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setInteractiveDynFlags DynFlags
idflags1
Maybe [Char] -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint (DynFlags -> Maybe [Char]
interactivePrint DynFlags
idflags1) Bool
False
DynFlags
dflags0 <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
interactive_only) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(DynFlags
dflags1, [Located [Char]]
_, [Warn]
_) <- IO (DynFlags, [Located [Char]], [Warn])
-> m (DynFlags, [Located [Char]], [Warn])
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (DynFlags, [Located [Char]], [Warn])
-> m (DynFlags, [Located [Char]], [Warn]))
-> IO (DynFlags, [Located [Char]], [Warn])
-> m (DynFlags, [Located [Char]], [Warn])
forall a b. (a -> b) -> a -> b
$ DynFlags
-> [Located [Char]] -> IO (DynFlags, [Located [Char]], [Warn])
forall (m :: Type -> Type).
MonadIO m =>
DynFlags
-> [Located [Char]] -> m (DynFlags, [Located [Char]], [Warn])
DynFlags.parseDynamicFlagsCmdLine DynFlags
dflags0 [Located [Char]]
lopts
Bool
must_reload <- DynFlags -> m Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags DynFlags
dflags1
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let dflags2 :: DynFlags
dflags2 = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let interp :: Interp
interp = HscEnv -> Interp
hscInterp HscEnv
hsc_env
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DynFlags -> DynFlags -> Bool
packageFlagsChanged DynFlags
dflags2 DynFlags
dflags0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Int
verbosity DynFlags
dflags2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ([Char] -> IO ()) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
[Char]
"package flags have changed, resetting and loading new packages..."
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearCaches
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
must_reload (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let units :: [UnitId]
units = UnitState -> [UnitId]
preloadUnits ((() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env)
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> HscEnv -> [UnitId] -> IO ()
Loader.loadPackages Interp
interp HscEnv
hsc_env [UnitId]
units
Bool -> Maybe ModuleGraph -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> Maybe ModuleGraph -> m ()
setContextAfterLoad Bool
False Maybe ModuleGraph
forall a. Maybe a
Nothing
DynFlags
idflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
DynFlags -> m ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setInteractiveDynFlags
DynFlags
idflags{ packageFlags = packageFlags dflags2 }
let ld0length :: Int
ld0length = [Option] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length ([Option] -> Int) -> [Option] -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> [Option]
ldInputs DynFlags
dflags0
fmrk0length :: Int
fmrk0length = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ DynFlags -> [[Char]]
cmdlineFrameworks DynFlags
dflags0
newLdInputs :: [Option]
newLdInputs = Int -> [Option] -> [Option]
forall a. Int -> [a] -> [a]
drop Int
ld0length (DynFlags -> [Option]
ldInputs DynFlags
dflags2)
newCLFrameworks :: [[Char]]
newCLFrameworks = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
fmrk0length (DynFlags -> [[Char]]
cmdlineFrameworks DynFlags
dflags2)
dflags' :: DynFlags
dflags' = DynFlags
dflags2 { ldInputs = newLdInputs
, cmdlineFrameworks = newCLFrameworks
}
hsc_env' :: HscEnv
hsc_env' = (() :: Constraint) => DynFlags -> HscEnv -> HscEnv
DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags' HscEnv
hsc_env
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Option] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Option]
newLdInputs Bool -> Bool -> Bool
&& [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
newCLFrameworks)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Interp -> HscEnv -> IO ()
Loader.loadCmdLineLibs (HscEnv -> Interp
hscInterp HscEnv
hsc_env') HscEnv
hsc_env'
() -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
unsetOptions :: GhciMonad m => String -> m ()
unsetOptions :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
unsetOptions [Char]
str
=
let opts :: [[Char]]
opts = [Char] -> [[Char]]
words [Char]
str
([[Char]]
minus_opts, [[Char]]
rest1) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition [Char] -> Bool
isMinus [[Char]]
opts
([[Char]]
plus_opts, [[Char]]
rest2) = ([Char] -> Either [Char] [Char])
-> [[Char]] -> ([[Char]], [[Char]])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith [Char] -> Either [Char] [Char]
isPlus [[Char]]
rest1
([[Char]]
other_opts, [[Char]]
rest3) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` (([Char], m ()) -> [Char]) -> [([Char], m ())] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], m ()) -> [Char]
forall a b. (a, b) -> a
fst [([Char], m ())]
defaulters) [[Char]]
rest2
defaulters :: [([Char], m ())]
defaulters =
[ ([Char]
"args" , [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setArgs [[Char]]
default_args)
, ([Char]
"prog" , [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setProg [Char]
default_progname)
, ([Char]
"prompt" , PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPrompt PromptFunction
default_prompt)
, ([Char]
"prompt-cont", PromptFunction -> m ()
forall (m :: Type -> Type). GhciMonad m => PromptFunction -> m ()
setPromptCont PromptFunction
default_prompt_cont)
, ([Char]
"editor" , IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO [Char]
findEditor m [Char] -> ([Char] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setEditor)
, ([Char]
"stop" , [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setStop [Char]
default_stop)
]
no_flag :: [Char] -> m [Char]
no_flag (Char
'-':Char
'f':[Char]
rest) = [Char] -> m [Char]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char]
"-fno-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest)
no_flag (Char
'-':Char
'X':[Char]
rest) = [Char] -> m [Char]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char]
"-XNo" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rest)
no_flag [Char]
f = GhcException -> m [Char]
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
ProgramError ([Char]
"don't know how to reverse " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f))
in case [[Char]]
rest3 of
[Char]
opt:[[Char]]
_ -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn ([Char]
"unknown option: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
opt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"))
[] -> do
([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe (m ()) -> m ()
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe (m ()) -> m ())
-> ([Char] -> Maybe (m ())) -> [Char] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char] -> [([Char], m ())] -> Maybe (m ()))
-> [([Char], m ())] -> [Char] -> Maybe (m ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [([Char], m ())] -> Maybe (m ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [([Char], m ())]
defaulters) [[Char]]
other_opts
([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
unsetOpt [[Char]]
plus_opts
[[Char]]
no_flags <- ([Char] -> m [Char]) -> [[Char]] -> m [[Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM [Char] -> m [Char]
forall {m :: Type -> Type}. Monad m => [Char] -> m [Char]
no_flag [[Char]]
minus_opts
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
no_flags)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
newDynFlags Bool
False [[Char]]
no_flags
isMinus :: String -> Bool
isMinus :: [Char] -> Bool
isMinus (Char
'-':[Char]
_) = Bool
True
isMinus [Char]
_ = Bool
False
isPlus :: String -> Either String String
isPlus :: [Char] -> Either [Char] [Char]
isPlus (Char
'+':[Char]
opt) = [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left [Char]
opt
isPlus [Char]
other = [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right [Char]
other
setOpt, unsetOpt :: GhciMonad m => String -> m ()
setOpt :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setOpt [Char]
str
= case [Char] -> Maybe GHCiOption
strToGHCiOpt [Char]
str of
Maybe GHCiOption
Nothing -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn ([Char]
"unknown option: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"))
Just GHCiOption
o -> GHCiOption -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m ()
setOption GHCiOption
o
unsetOpt :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
unsetOpt [Char]
str
= case [Char] -> Maybe GHCiOption
strToGHCiOpt [Char]
str of
Maybe GHCiOption
Nothing -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn ([Char]
"unknown option: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"))
Just GHCiOption
o -> GHCiOption -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m ()
unsetOption GHCiOption
o
strToGHCiOpt :: String -> (Maybe GHCiOption)
strToGHCiOpt :: [Char] -> Maybe GHCiOption
strToGHCiOpt [Char]
"m" = GHCiOption -> Maybe GHCiOption
forall a. a -> Maybe a
Just GHCiOption
Multiline
strToGHCiOpt [Char]
"s" = GHCiOption -> Maybe GHCiOption
forall a. a -> Maybe a
Just GHCiOption
ShowTiming
strToGHCiOpt [Char]
"t" = GHCiOption -> Maybe GHCiOption
forall a. a -> Maybe a
Just GHCiOption
ShowType
strToGHCiOpt [Char]
"r" = GHCiOption -> Maybe GHCiOption
forall a. a -> Maybe a
Just GHCiOption
RevertCAFs
strToGHCiOpt [Char]
"c" = GHCiOption -> Maybe GHCiOption
forall a. a -> Maybe a
Just GHCiOption
CollectInfo
strToGHCiOpt [Char]
_ = Maybe GHCiOption
forall a. Maybe a
Nothing
optToStr :: GHCiOption -> String
optToStr :: GHCiOption -> [Char]
optToStr GHCiOption
Multiline = [Char]
"m"
optToStr GHCiOption
ShowTiming = [Char]
"s"
optToStr GHCiOption
ShowType = [Char]
"t"
optToStr GHCiOption
RevertCAFs = [Char]
"r"
optToStr GHCiOption
CollectInfo = [Char]
"c"
showCmd :: forall m. GhciMonad m => String -> m ()
showCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
showCmd [Char]
"" = Bool -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
showOptions Bool
False
showCmd [Char]
"-a" = Bool -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
showOptions Bool
True
showCmd [Char]
str = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let lookupCmd :: String -> Maybe (m ())
lookupCmd :: [Char] -> Maybe (m ())
lookupCmd [Char]
name = [Char] -> [([Char], m ())] -> Maybe (m ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
name ([([Char], m ())] -> Maybe (m ()))
-> [([Char], m ())] -> Maybe (m ())
forall a b. (a -> b) -> a -> b
$ ((Bool, [Char], m ()) -> ([Char], m ()))
-> [(Bool, [Char], m ())] -> [([Char], m ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
_,[Char]
b,m ()
c) -> ([Char]
b,m ()
c)) [(Bool, [Char], m ())]
cmds
action :: String -> m () -> (Bool, String, m ())
action :: [Char] -> m () -> (Bool, [Char], m ())
action [Char]
name m ()
m = (Bool
True, [Char]
name, m ()
m)
hidden :: String -> m () -> (Bool, String, m ())
hidden :: [Char] -> m () -> (Bool, [Char], m ())
hidden [Char]
name m ()
m = (Bool
False, [Char]
name, m ()
m)
cmds :: [(Bool, [Char], m ())]
cmds =
[ [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"args" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show (GHCiState -> [[Char]]
GhciMonad.args GHCiState
st))
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"prog" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> [Char]
forall a. Show a => a -> [Char]
show (GHCiState -> [Char]
progname GHCiState
st))
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"editor" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> [Char]
forall a. Show a => a -> [Char]
show (GHCiState -> [Char]
editor GHCiState
st))
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"stop" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> [Char]
forall a. Show a => a -> [Char]
show (GHCiState -> [Char]
stop GHCiState
st))
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"imports" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhciMonad m => m ()
showImports
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"modules" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showModules
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"bindings" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showBindings
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"linker" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ do
SDoc
msg <- IO SDoc -> m SDoc
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO SDoc -> m SDoc) -> IO SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ Interp -> IO SDoc
Loader.showLoaderState (HscEnv -> Interp
hscInterp HscEnv
hsc_env)
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags SDoc
msg
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"breaks" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhciMonad m => m ()
showBkptTable
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"context" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showContext
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"packages" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showUnits
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"paths" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showPaths
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"language" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showLanguages
, [Char] -> m () -> (Bool, [Char], m ())
hidden [Char]
"languages" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showLanguages
, [Char] -> m () -> (Bool, [Char], m ())
hidden [Char]
"lang" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showLanguages
, [Char] -> m () -> (Bool, [Char], m ())
action [Char]
"targets" (m () -> (Bool, [Char], m ())) -> m () -> (Bool, [Char], m ())
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showTargets
]
case [Char] -> [[Char]]
words [Char]
str of
[[Char]
w] | Just m ()
action <- [Char] -> Maybe (m ())
lookupCmd [Char]
w -> m ()
action
[[Char]]
_ -> let helpCmds :: [SDoc]
helpCmds = [ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
name | (Bool
True, [Char]
name, m ()
_) <- [(Bool, [Char], m ())]
cmds ]
in GhcException -> m ()
forall a. GhcException -> a
throwGhcException (GhcException -> m ()) -> GhcException -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags
(SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"syntax:") Int
4
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":show") Int
6
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" |") [SDoc]
helpCmds)
showiCmd :: GHC.GhcMonad m => String -> m ()
showiCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
showiCmd [Char]
str = do
case [Char] -> [[Char]]
words [Char]
str of
[[Char]
"languages"] -> m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showiLanguages
[[Char]
"language"] -> m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showiLanguages
[[Char]
"lang"] -> m ()
forall (m :: Type -> Type). GhcMonad m => m ()
showiLanguages
[[Char]]
_ -> GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError ([Char]
"syntax: :showi language"))
showImports :: GhciMonad m => m ()
showImports :: forall (m :: Type -> Type). GhciMonad m => m ()
showImports = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let rem_ctx :: [InteractiveImport]
rem_ctx = [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a]
reverse (GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st)
trans_ctx :: [InteractiveImport]
trans_ctx = GHCiState -> [InteractiveImport]
transient_ctx GHCiState
st
show_one :: InteractiveImport -> [Char]
show_one (IIModule ModuleName
star_m)
= [Char]
":module +*" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
star_m
show_one (IIDecl ImportDecl GhcPs
imp) = DynFlags -> ImportDecl GhcPs -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags ImportDecl GhcPs
imp
[InteractiveImport]
prel_iidecls <- [InteractiveImport] -> m [InteractiveImport]
forall (m :: Type -> Type).
GhciMonad m =>
[InteractiveImport] -> m [InteractiveImport]
getImplicitPreludeImports ([InteractiveImport]
rem_ctx [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a] -> [a]
++ [InteractiveImport]
trans_ctx)
let show_prel :: InteractiveImport -> [Char]
show_prel InteractiveImport
p = InteractiveImport -> [Char]
show_one InteractiveImport
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -- implicit"
show_extra :: ImportDecl GhcPs -> [Char]
show_extra ImportDecl GhcPs
p = InteractiveImport -> [Char]
show_one (ImportDecl GhcPs -> InteractiveImport
IIDecl ImportDecl GhcPs
p) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -- fixed"
trans_comment :: [Char] -> [Char]
trans_comment [Char]
s = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -- added automatically" :: String
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn ((InteractiveImport -> [Char]) -> [InteractiveImport] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map InteractiveImport -> [Char]
show_one [InteractiveImport]
rem_ctx [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
(InteractiveImport -> [Char]) -> [InteractiveImport] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
trans_comment ([Char] -> [Char])
-> (InteractiveImport -> [Char]) -> InteractiveImport -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InteractiveImport -> [Char]
show_one) [InteractiveImport]
trans_ctx [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
(InteractiveImport -> [Char]) -> [InteractiveImport] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map InteractiveImport -> [Char]
show_prel [InteractiveImport]
prel_iidecls [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
(ImportDecl GhcPs -> [Char]) -> [ImportDecl GhcPs] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl GhcPs -> [Char]
show_extra (GHCiState -> [ImportDecl GhcPs]
extra_imports GHCiState
st))
showModules :: GHC.GhcMonad m => m ()
showModules :: forall (m :: Type -> Type). GhcMonad m => m ()
showModules = do
[ModSummary]
loaded_mods <- m [ModSummary]
forall (m :: Type -> Type). GhcMonad m => m [ModSummary]
getLoadedModules
let show_one :: ModSummary -> m ()
show_one ModSummary
ms = do [Char]
m <- ModSummary -> m [Char]
forall (m :: Type -> Type). GhcMonad m => ModSummary -> m [Char]
GHC.showModule ModSummary
ms; IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn [Char]
m)
(ModSummary -> m ()) -> [ModSummary] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModSummary -> m ()
forall {m :: Type -> Type}. GhcMonad m => ModSummary -> m ()
show_one [ModSummary]
loaded_mods
getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
getLoadedModules :: forall (m :: Type -> Type). GhcMonad m => m [ModSummary]
getLoadedModules = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
(ModSummary -> m Bool) -> [ModSummary] -> m [ModSummary]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModSummary -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModSummary -> m Bool
isLoadedModSummary (ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph)
showBindings :: GHC.GhcMonad m => m ()
showBindings :: forall (m :: Type -> Type). GhcMonad m => m ()
showBindings = do
[TyThing]
bindings <- m [TyThing]
forall (m :: Type -> Type). GhcMonad m => m [TyThing]
GHC.getBindings
([ClsInst]
insts, [FamInst]
finsts) <- m ([ClsInst], [FamInst])
forall (m :: Type -> Type). GhcMonad m => m ([ClsInst], [FamInst])
GHC.getInsts
let idocs :: [SDoc]
idocs = (ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstanceHdr [ClsInst]
insts
fidocs :: [SDoc]
fidocs = (FamInst -> SDoc) -> [FamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst [FamInst]
finsts
binds :: [TyThing]
binds = (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TyThing -> Bool) -> TyThing -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> Bool
isDerivedOccName (OccName -> Bool) -> (TyThing -> OccName) -> TyThing -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName) [TyThing]
bindings
[SDoc]
docs <- (TyThing -> m SDoc) -> [TyThing] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM TyThing -> m SDoc
forall {m :: Type -> Type}. GhcMonad m => TyThing -> m SDoc
makeDoc ([TyThing] -> [TyThing]
forall a. [a] -> [a]
reverse [TyThing]
binds)
(SDoc -> m ()) -> [SDoc] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUserPartWay ([SDoc]
docs [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
idocs [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
fidocs)
where
makeDoc :: TyThing -> m SDoc
makeDoc (AnId Id
i) = Id -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Id -> m SDoc
pprTypeAndContents Id
i
makeDoc TyThing
tt = do
Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
mb_stuff <- 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
False (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tt)
SDoc -> m SDoc
forall a. a -> m a
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
-> ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc)
-> Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
-> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"") (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprTT Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
mb_stuff
pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
pprTT :: (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprTT (TyThing
thing, Fixity
fixity, [ClsInst]
_cls_insts, [FamInst]
_fam_insts, SDoc
_docs)
= ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
showToHeader TyThing
thing
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
printTyThing :: GHC.GhcMonad m => TyThing -> m ()
printTyThing :: forall (m :: Type -> Type). GhcMonad m => TyThing -> m ()
printTyThing TyThing
tyth = SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (ShowSub -> TyThing -> SDoc
pprTyThing ShowSub
showToHeader TyThing
tyth)
isLoadedModSummary :: GHC.GhcMonad m => ModSummary -> m Bool
isLoadedModSummary :: forall (m :: Type -> Type). GhcMonad m => ModSummary -> m Bool
isLoadedModSummary ModSummary
ms = UnitId -> ModuleName -> m Bool
forall (m :: Type -> Type).
GhcMonad m =>
UnitId -> ModuleName -> m Bool
GHC.isLoadedModule (ModSummary -> UnitId
ms_unitid ModSummary
ms) (ModSummary -> ModuleName
ms_mod_name ModSummary
ms)
showBkptTable :: GhciMonad m => m ()
showBkptTable :: forall (m :: Type -> Type). GhciMonad m => m ()
showBkptTable = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap BreakLocation -> SDoc
prettyLocations (GHCiState -> IntMap BreakLocation
breaks GHCiState
st)
showContext :: GHC.GhcMonad m => m ()
showContext :: forall (m :: Type -> Type). GhcMonad m => m ()
showContext = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Resume -> SDoc) -> [Resume] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Resume -> SDoc
pp_resume ([Resume] -> [Resume]
forall a. [a] -> [a]
reverse [Resume]
resumes))
where
pp_resume :: Resume -> SDoc
pp_resume Resume
res =
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"--> " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Resume -> [Char]
GHC.resumeStmt Resume
res)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (Resume -> SDoc
pprStopped Resume
res)
pprStopped :: GHC.Resume -> SDoc
pprStopped :: Resume -> SDoc
pprStopped Resume
res =
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Stopped in"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ((case Maybe ModuleName
mb_mod_name of
Maybe ModuleName
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
Just ModuleName
mod_name -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (ModuleName -> FastString
moduleNameFS ModuleName
mod_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'.')
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text (Resume -> [Char]
GHC.resumeDecl Resume
res))
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
',' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Resume -> SrcSpan
GHC.resumeSpan Resume
res)
where
mb_mod_name :: Maybe ModuleName
mb_mod_name = GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName)
-> (BreakInfo -> GenModule Unit) -> BreakInfo -> ModuleName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BreakInfo -> GenModule Unit
GHC.breakInfo_module (BreakInfo -> ModuleName) -> Maybe BreakInfo -> Maybe ModuleName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Resume -> Maybe BreakInfo
GHC.resumeBreakInfo Resume
res
showUnits :: GHC.GhcMonad m => m ()
showUnits :: forall (m :: Type -> Type). GhcMonad m => m ()
showUnits = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let pkg_flags :: [PackageFlag]
pkg_flags = DynFlags -> [PackageFlag]
packageFlags DynFlags
dflags
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char]
"active package flags:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++if [PackageFlag] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [PackageFlag]
pkg_flags then [Char]
" none" else [Char]
"") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((PackageFlag -> SDoc) -> [PackageFlag] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> SDoc
pprFlag [PackageFlag]
pkg_flags))
showPaths :: GHC.GhcMonad m => m ()
showPaths :: forall (m :: Type -> Type). GhcMonad m => m ()
showPaths = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Char]
cwd <- IO [Char]
getCurrentDirectory
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"current working directory: " SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
cwd)
let ipaths :: [[Char]]
ipaths = DynFlags -> [[Char]]
importPaths DynFlags
dflags
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text ([Char]
"module import search paths:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
ipaths then [Char]
" none" else [Char]
"") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [[Char]]
ipaths))
showLanguages :: GHC.GhcMonad m => m ()
showLanguages :: forall (m :: Type -> Type). GhcMonad m => m ()
showLanguages = m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags m DynFlags -> (DynFlags -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (DynFlags -> IO ()) -> DynFlags -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DynFlags -> IO ()
showLanguages' Bool
False
showiLanguages :: GHC.GhcMonad m => m ()
showiLanguages :: forall (m :: Type -> Type). GhcMonad m => m ()
showiLanguages = m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags m DynFlags -> (DynFlags -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (DynFlags -> IO ()) -> DynFlags -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> DynFlags -> IO ()
showLanguages' Bool
False
showLanguages' :: Bool -> DynFlags -> IO ()
showLanguages' :: Bool -> DynFlags -> IO ()
showLanguages' Bool
show_all DynFlags
dflags =
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
[ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"base language is: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
case Language
lang of
Language
Haskell98 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Haskell98"
Language
Haskell2010 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Haskell2010"
Language
GHC2021 -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"GHC2021"
, (if Bool
show_all then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"all active language options:"
else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"with the following modifiers:") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FlagSpec Extension -> SDoc) -> [FlagSpec Extension] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((Extension -> DynFlags -> Bool) -> FlagSpec Extension -> SDoc
setting Extension -> DynFlags -> Bool
xopt) [FlagSpec Extension]
DynFlags.xFlags))
]
where
setting :: (Extension -> DynFlags -> Bool) -> FlagSpec Extension -> SDoc
setting Extension -> DynFlags -> Bool
test FlagSpec Extension
flag
| Bool
quiet = SDoc
forall doc. IsOutput doc => doc
empty
| Bool
is_on = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-X" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
name
| Bool
otherwise = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"-XNo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
name
where name :: [Char]
name = FlagSpec Extension -> [Char]
forall flag. FlagSpec flag -> [Char]
flagSpecName FlagSpec Extension
flag
f :: Extension
f = FlagSpec Extension -> Extension
forall flag. FlagSpec flag -> flag
flagSpecFlag FlagSpec Extension
flag
is_on :: Bool
is_on = Extension -> DynFlags -> Bool
test Extension
f DynFlags
dflags
quiet :: Bool
quiet = Bool -> Bool
not Bool
show_all Bool -> Bool -> Bool
&& Extension -> DynFlags -> Bool
test Extension
f DynFlags
default_dflags Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
is_on
default_dflags :: DynFlags
default_dflags = Settings -> DynFlags
defaultDynFlags (DynFlags -> Settings
settings DynFlags
dflags) DynFlags -> Maybe Language -> DynFlags
`lang_set` Language -> Maybe Language
forall a. a -> Maybe a
Just Language
lang
lang :: Language
lang = Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
GHC2021 (DynFlags -> Maybe Language
language DynFlags
dflags)
showTargets :: GHC.GhcMonad m => m ()
showTargets :: forall (m :: Type -> Type). GhcMonad m => m ()
showTargets = (Target -> m ()) -> [Target] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Target -> m ()
forall (m :: Type -> Type). GhcMonad m => Target -> m ()
showTarget ([Target] -> m ()) -> m [Target] -> m ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< m [Target]
forall (m :: Type -> Type). GhcMonad m => m [Target]
GHC.getTargets
where
showTarget :: GHC.GhcMonad m => Target -> m ()
showTarget :: forall (m :: Type -> Type). GhcMonad m => Target -> m ()
showTarget Target { targetId :: Target -> TargetId
targetId = TargetFile [Char]
f Maybe Phase
_ } = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn [Char]
f)
showTarget Target { targetId :: Target -> TargetId
targetId = TargetModule ModuleName
m } =
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Char]
moduleNameString ModuleName
m)
completeCmd :: String -> GHCi ()
completeCmd :: [Char] -> GHCi ()
completeCmd [Char]
argLine0 = case [Char] -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
parseLine [Char]
argLine0 of
Just ([Char]
"repl", (Maybe Int, Maybe Int)
resultRange, [Char]
left) -> do
([Char]
unusedLine,[Completion]
compls) <- CompletionFunc GHCi
ghciCompleteWord ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
left,[Char]
"")
let compls' :: [Completion]
compls' = (Maybe Int, Maybe Int) -> [Completion] -> [Completion]
forall {a}. (Maybe Int, Maybe Int) -> [a] -> [a]
takeRange (Maybe Int, Maybe Int)
resultRange [Completion]
compls
IO () -> GHCi ()
forall a. IO a -> GHCi a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> ([Char] -> IO ()) -> [Char] -> GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> GHCi ()) -> [Char] -> GHCi ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Completion] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Completion]
compls'), Int -> [Char]
forall a. Show a => a -> [Char]
show ([Completion] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Completion]
compls), [Char] -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
unusedLine) ]
[Completion] -> (Completion -> GHCi ()) -> GHCi ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Maybe Int, Maybe Int) -> [Completion] -> [Completion]
forall {a}. (Maybe Int, Maybe Int) -> [a] -> [a]
takeRange (Maybe Int, Maybe Int)
resultRange [Completion]
compls) ((Completion -> GHCi ()) -> GHCi ())
-> (Completion -> GHCi ()) -> GHCi ()
forall a b. (a -> b) -> a -> b
$ \(Completion [Char]
r [Char]
_ Bool
_) -> do
IO () -> GHCi ()
forall a. IO a -> GHCi a
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 ()
forall a. Show a => a -> IO ()
print [Char]
r
Maybe ([Char], (Maybe Int, Maybe Int), [Char])
_ -> GhcException -> GHCi ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"Syntax: :complete repl [<range>] <quoted-string-to-complete>")
where
parseLine :: [Char] -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
parseLine [] = Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a. Maybe a
Nothing
parseLine [Char]
argLine = case [Char] -> ([Char], [Char])
breakSpace [Char]
argLine of
([Char]
_, []) -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a. Maybe a
Nothing
([Char]
dom, rest1 :: [Char]
rest1@(Char
'"' : [Char]
_)) -> ([Char]
dom,,) ((Maybe Int, Maybe Int)
-> [Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
-> Maybe (Maybe Int, Maybe Int)
-> Maybe ([Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe (Maybe Int, Maybe Int)
parseRange [Char]
"" Maybe ([Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
-> Maybe [Char] -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ([Char] -> Maybe [Char]
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
rest1 :: Maybe String)
([Char]
dom, [Char]
rest1) -> ([Char]
dom,,) ((Maybe Int, Maybe Int)
-> [Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
-> Maybe (Maybe Int, Maybe Int)
-> Maybe ([Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe (Maybe Int, Maybe Int)
parseRange [Char]
rng Maybe ([Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
-> Maybe [Char] -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [Char] -> Maybe [Char]
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
rest2
where
([Char]
rng, [Char]
rest2) = [Char] -> ([Char], [Char])
breakSpace [Char]
rest1
breakSpace :: [Char] -> ([Char], [Char])
breakSpace = ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
forall a b. (a -> b) -> ([Char], a) -> ([Char], b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) (([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace
takeRange :: (Maybe Int, Maybe Int) -> [a] -> [a]
takeRange (Maybe Int
lb,Maybe Int
ub) = ([a] -> [a]) -> (Int -> [a] -> [a]) -> Maybe Int -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> [a] -> [a]) -> (Int -> Int) -> Int -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred) Maybe Int
lb ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> (Int -> [a] -> [a]) -> Maybe Int -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Maybe Int
ub
parseRange :: String -> Maybe (Maybe Int,Maybe Int)
parseRange :: [Char] -> Maybe (Maybe Int, Maybe Int)
parseRange [Char]
s = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit [Char]
s of
([Char]
_, [Char]
"") ->
(Maybe Int, Maybe Int) -> Maybe (Maybe Int, Maybe Int)
forall a. a -> Maybe a
Just (Maybe Int
forall a. Maybe a
Nothing, [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
bndRead [Char]
s)
([Char]
s1, Char
'-' : [Char]
s2)
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
s2 ->
(Maybe Int, Maybe Int) -> Maybe (Maybe Int, Maybe Int)
forall a. a -> Maybe a
Just ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
bndRead [Char]
s1, [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
bndRead [Char]
s2)
([Char], [Char])
_ ->
Maybe (Maybe Int, Maybe Int)
forall a. Maybe a
Nothing
where
bndRead :: [Char] -> Maybe a
bndRead [Char]
x = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
x then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just ([Char] -> a
forall a. Read a => [Char] -> a
read [Char]
x)
completeGhciCommand, completeMacro, completeIdentifier, completeModule,
completeSetModule, completeSeti, completeShowiOptions,
completeHomeModule, completeSetOptions, completeShowOptions,
completeHomeModuleOrFile, completeExpression, completeBreakpoint
:: GhciMonad m => CompletionFunc m
ghciCompleteWord :: CompletionFunc GHCi
ghciCompleteWord :: CompletionFunc GHCi
ghciCompleteWord line :: ([Char], [Char])
line@([Char]
left,[Char]
_) = case [Char]
firstWord of
Char
':':[Char]
cmd | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
rest -> CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeGhciCommand ([Char], [Char])
line
| Bool
otherwise -> do
CompletionFunc GHCi
completion <- [Char] -> GHCi (CompletionFunc GHCi)
forall {m :: Type -> Type}.
GhciMonad m =>
[Char] -> m (CompletionFunc GHCi)
lookupCompletion [Char]
cmd
CompletionFunc GHCi
completion ([Char], [Char])
line
[Char]
"import" -> CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule ([Char], [Char])
line
[Char]
_ -> CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression ([Char], [Char])
line
where
([Char]
firstWord,[Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
left
lookupCompletion :: [Char] -> m (CompletionFunc GHCi)
lookupCompletion (Char
'!':[Char]
_) = CompletionFunc GHCi -> m (CompletionFunc GHCi)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename
lookupCompletion [Char]
c = do
Maybe Command
maybe_cmd <- [Char] -> m (Maybe Command)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
c
case Maybe Command
maybe_cmd of
Just Command
cmd -> CompletionFunc GHCi -> m (CompletionFunc GHCi)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Command -> CompletionFunc GHCi
cmdCompletionFunc Command
cmd)
Maybe Command
Nothing -> CompletionFunc GHCi -> m (CompletionFunc GHCi)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename
completeGhciCommand :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeGhciCommand = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
" " (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> 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]
cmds <- GHCiState -> [Command]
ghci_commands (GHCiState -> [Command]) -> m GHCiState -> m [Command]
forall a b. (a -> b) -> m a -> m b
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
let macro_names :: [[Char]]
macro_names = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Char
':'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> ([Command] -> [[Char]]) -> [Command] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> [Char]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Command -> [Char]
cmdName ([Command] -> [[Char]]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Command]
macros
let command_names :: [[Char]]
command_names = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Char
':'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> ([Command] -> [[Char]]) -> [Command] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command -> [Char]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Command -> [Char]
cmdName ([Command] -> [[Char]]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (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]
cmds
let{ candidates :: [[Char]]
candidates = case [Char]
w of
Char
':' : Char
':' : [Char]
_ -> ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Char
':'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) [[Char]]
command_names
[Char]
_ -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
macro_names [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
command_names }
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
`isPrefixOptOf`) [[Char]]
candidates
completeMacro :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeMacro = ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleter (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
[Command]
cmds <- 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
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ((Command -> [Char]) -> [Command] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Command -> [Char]
cmdName [Command]
cmds))
completeIdentifier :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier line :: ([Char], [Char])
line@([Char]
left, [Char]
_) =
case [Char]
left of
(Char
'.':[Char]
_) -> [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter ([Char]
specials [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
spaces) [Char] -> m [[Char]]
forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
complete ([Char], [Char])
line
(Char
x:[Char]
_) | Char -> Bool
isSymbolChar Char
x -> (Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
(Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter' (\Char
c -> Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` ([Char]
specials [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
spaces) Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSymbolChar Char
c))
[Char] -> m [[Char]]
forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
complete ([Char], [Char])
line
[Char]
_ -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleter [Char] -> m [[Char]]
forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
complete ([Char], [Char])
line
where
complete :: [Char] -> m [[Char]]
complete [Char]
w = do
[RdrName]
rdrs <- m [RdrName]
forall (m :: Type -> Type). GhcMonad m => m [RdrName]
GHC.getRdrNamesInScope
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ((RdrName -> [Char]) -> [RdrName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> RdrName -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags) [RdrName]
rdrs))
completeBreakpoint :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeBreakpoint = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
spaces (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
let ([Char]
mod_str, [Char]
_, [Char]
_) = [Char] -> ([Char], [Char], [Char])
splitIdent [Char]
w
[[Char]]
bids_mod_breaks <- [Char] -> m [[Char]]
forall (m :: Type -> Type). GhciMonad m => [Char] -> m [[Char]]
bidsFromModBreaks [Char]
mod_str
[[Char]]
bids_inscopes <- m [[Char]]
forall (m :: Type -> Type). GhciMonad m => m [[Char]]
bidsFromInscopes
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
w) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
bids_mod_breaks [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
bids_inscopes
where
bidsFromModBreaks :: GhciMonad m => String -> m [String]
bidsFromModBreaks :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m [[Char]]
bidsFromModBreaks [Char]
mod_pref = do
[GenModule Unit]
imods <- m [GenModule Unit]
forall (m :: Type -> Type). GhciMonad m => m [GenModule Unit]
interpretedHomeMods
let pmods :: [GenModule Unit]
pmods = (GenModule Unit -> Bool) -> [GenModule Unit] -> [GenModule Unit]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
mod_pref) ([Char] -> Bool)
-> (GenModule Unit -> [Char]) -> GenModule Unit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> [Char]
showModule) [GenModule Unit]
imods
[ModuleName]
nonquals <- case [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
mod_pref of
Bool
True -> do
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
[ModuleName] -> m [ModuleName]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [ ModuleName
m | IIModule ModuleName
m <- [InteractiveImport]
imports]
Bool
False -> [ModuleName] -> m [ModuleName]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
[[[Char]]]
bidss <- (GenModule Unit -> m [[Char]]) -> [GenModule Unit] -> m [[[Char]]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM ([ModuleName] -> GenModule Unit -> m [[Char]]
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> GenModule Unit -> m [[Char]]
bidsByModule [ModuleName]
nonquals) [GenModule Unit]
pmods
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
bidss
interpretedHomeMods :: GhciMonad m => m [Module]
interpretedHomeMods :: forall (m :: Type -> Type). GhciMonad m => m [GenModule Unit]
interpretedHomeMods = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let hmods :: [GenModule Unit]
hmods = ModSummary -> GenModule Unit
ms_mod (ModSummary -> GenModule Unit) -> [ModSummary] -> [GenModule Unit]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph
(GenModule Unit -> m Bool)
-> [GenModule Unit] -> m [GenModule Unit]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.moduleIsInterpreted [GenModule Unit]
hmods
bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
bidsByModule :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> GenModule Unit -> m [[Char]]
bidsByModule [ModuleName]
nonquals GenModule Unit
mod = do
(Array Int SrcSpan
_, Array Int [[Char]]
decls) <- GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
getModBreak GenModule Unit
mod
let bids :: [[Char]]
bids = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
declPath ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Int [[Char]] -> [[[Char]]]
forall i e. Array i e -> [e]
elems Array Int [[Char]]
decls
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ case (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule Unit
mod) ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ModuleName]
nonquals of
Bool
True -> [[Char]]
bids
Bool
False -> ([Char] -> [Char] -> [Char]
combineModIdent (GenModule Unit -> [Char]
showModule GenModule Unit
mod)) ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
bids
bidsFromInscopes :: GhciMonad m => m [String]
bidsFromInscopes :: forall (m :: Type -> Type). GhciMonad m => m [[Char]]
bidsFromInscopes = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
[RdrName]
rdrs <- m [RdrName]
forall (m :: Type -> Type). GhcMonad m => m [RdrName]
GHC.getRdrNamesInScope
[[([Char], GenModule Unit)]]
inscopess <- ([Char] -> m [([Char], GenModule Unit)])
-> [[Char]] -> m [[([Char], GenModule Unit)]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM [Char] -> m [([Char], GenModule Unit)]
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m [([Char], GenModule Unit)]
createInscope ([[Char]] -> m [[([Char], GenModule Unit)]])
-> [[Char]] -> m [[([Char], GenModule Unit)]]
forall a b. (a -> b) -> a -> b
$ (DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags (SDoc -> [Char]) -> (RdrName -> SDoc) -> RdrName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr) (RdrName -> [Char]) -> [RdrName] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [RdrName]
rdrs
[GenModule Unit]
imods <- m [GenModule Unit]
forall (m :: Type -> Type). GhciMonad m => m [GenModule Unit]
interpretedHomeMods
let topLevels :: [([Char], GenModule Unit)]
topLevels = (([Char], GenModule Unit) -> Bool)
-> [([Char], GenModule Unit)] -> [([Char], GenModule Unit)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((GenModule Unit -> [GenModule Unit] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [GenModule Unit]
imods) (GenModule Unit -> Bool)
-> (([Char], GenModule Unit) -> GenModule Unit)
-> ([Char], GenModule Unit)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], GenModule Unit) -> GenModule Unit
forall a b. (a, b) -> b
snd) ([([Char], GenModule Unit)] -> [([Char], GenModule Unit)])
-> [([Char], GenModule Unit)] -> [([Char], GenModule Unit)]
forall a b. (a -> b) -> a -> b
$ [[([Char], GenModule Unit)]] -> [([Char], GenModule Unit)]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[([Char], GenModule Unit)]]
inscopess
[[[Char]]]
bidss <- (([Char], GenModule Unit) -> m [[Char]])
-> [([Char], GenModule Unit)] -> m [[[Char]]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (([Char], GenModule Unit) -> m [[Char]]
forall (m :: Type -> Type).
GhciMonad m =>
([Char], GenModule Unit) -> m [[Char]]
addNestedDecls) [([Char], GenModule Unit)]
topLevels
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
bidss
createInscope :: GhciMonad m => String -> m [(String, Module)]
createInscope :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m [([Char], GenModule Unit)]
createInscope [Char]
str_rdr = do
NonEmpty Name
names <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
str_rdr
[([Char], GenModule Unit)] -> m [([Char], GenModule Unit)]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([([Char], GenModule Unit)] -> m [([Char], GenModule Unit)])
-> [([Char], GenModule Unit)] -> m [([Char], GenModule Unit)]
forall a b. (a -> b) -> a -> b
$ (GenModule Unit -> ([Char], GenModule Unit))
-> [GenModule Unit] -> [([Char], GenModule Unit)]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
str_rdr, ) ([GenModule Unit] -> [([Char], GenModule Unit)])
-> [GenModule Unit] -> [([Char], GenModule Unit)]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenModule Unit) -> [GenModule Unit]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (GenModule Unit) -> [GenModule Unit])
-> NonEmpty (GenModule Unit) -> [GenModule Unit]
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
GHC.nameModule (Name -> GenModule Unit)
-> NonEmpty Name -> NonEmpty (GenModule Unit)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
names
addNestedDecls :: GhciMonad m => (String, Module) -> m [String]
addNestedDecls :: forall (m :: Type -> Type).
GhciMonad m =>
([Char], GenModule Unit) -> m [[Char]]
addNestedDecls ([Char]
ident, GenModule Unit
mod) = do
(Array Int SrcSpan
_, Array Int [[Char]]
decls) <- GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
getModBreak GenModule Unit
mod
let ([Char]
mod_str, [Char]
topLvl, [Char]
_) = [Char] -> ([Char], [Char], [Char])
splitIdent [Char]
ident
ident_decls :: [[[Char]]]
ident_decls = [ [[Char]]
elm | elm :: [[Char]]
elm@([Char]
el : [[Char]]
_) <- Array Int [[Char]] -> [[[Char]]]
forall i e. Array i e -> [e]
elems Array Int [[Char]]
decls, [Char]
el [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
topLvl ]
bids :: [[Char]]
bids = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
declPath ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[[Char]]]
ident_decls
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
combineModIdent [Char]
mod_str) [[Char]]
bids
completeModule :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule = ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleterMod (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
let pkg_mods :: [ModuleName]
pkg_mods = UnitState -> [ModuleName]
allVisibleModules ((() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env)
[ModuleName]
loaded_mods <- ([ModSummary] -> [ModuleName]) -> m [ModSummary] -> m [ModuleName]
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM ((ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
GHC.ms_mod_name) m [ModSummary]
forall (m :: Type -> Type). GhcMonad m => m [ModSummary]
getLoadedModules
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> ModuleName -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)) ([ModuleName] -> [[Char]]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
loaded_mods [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
pkg_mods
completeSetModule :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetModule = [Char] -> (Maybe Char -> [Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> (Maybe Char -> [Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleterWithModifier [Char]
"+-" ((Maybe Char -> [Char] -> m [[Char]]) -> CompletionFunc m)
-> (Maybe Char -> [Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \Maybe Char
m [Char]
w -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[ModuleName]
modules <- case Maybe Char
m of
Just Char
'-' -> do
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
[ModuleName] -> m [ModuleName]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([ModuleName] -> m [ModuleName]) -> [ModuleName] -> m [ModuleName]
forall a b. (a -> b) -> a -> b
$ (InteractiveImport -> ModuleName)
-> [InteractiveImport] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map InteractiveImport -> ModuleName
iiModuleName [InteractiveImport]
imports
Maybe Char
_ -> do
let pkg_mods :: [ModuleName]
pkg_mods = UnitState -> [ModuleName]
allVisibleModules ((() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env)
[ModuleName]
loaded_mods <- ([ModSummary] -> [ModuleName]) -> m [ModSummary] -> m [ModuleName]
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM ((ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
GHC.ms_mod_name) m [ModSummary]
forall (m :: Type -> Type). GhcMonad m => m [ModSummary]
getLoadedModules
[ModuleName] -> m [ModuleName]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([ModuleName] -> m [ModuleName]) -> [ModuleName] -> m [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
loaded_mods [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
pkg_mods
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> ModuleName -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)) [ModuleName]
modules
completeHomeModule :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModule = ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleterMod [Char] -> m [[Char]]
forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
listHomeModules
listHomeModules :: GHC.GhcMonad m => String -> m [String]
listHomeModules :: forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
listHomeModules [Char]
w = do
ModuleGraph
g <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let home_mods :: [ModuleName]
home_mods = (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
GHC.ms_mod_name (ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
g)
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> [Char]) -> [ModuleName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> ModuleName -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags) [ModuleName]
home_mods
completeSetOptions :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetOptions = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
flagWordBreakChars (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[Char]]
opts)
where opts :: [[Char]]
opts = [Char]
"args"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"prog"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"prompt"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"prompt-cont"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"prompt-function"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
[Char]
"prompt-cont-function"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"editor"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
"stop"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
flagList
flagList :: [[Char]]
flagList = (NonEmpty [Char] -> [Char]) -> [NonEmpty [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
NE.head ([NonEmpty [Char]] -> [[Char]]) -> [NonEmpty [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [NonEmpty [Char]]
forall (f :: Type -> Type) a.
(Foldable f, Eq a) =>
f a -> [NonEmpty a]
NE.group ([[Char]] -> [NonEmpty [Char]]) -> [[Char]] -> [NonEmpty [Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
allNonDeprecatedFlags
completeSeti :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSeti = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
flagWordBreakChars (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[Char]]
flagList)
where flagList :: [[Char]]
flagList = (NonEmpty [Char] -> [Char]) -> [NonEmpty [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
NE.head ([NonEmpty [Char]] -> [[Char]]) -> [NonEmpty [Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [NonEmpty [Char]]
forall (f :: Type -> Type) a.
(Foldable f, Eq a) =>
f a -> [NonEmpty a]
NE.group ([[Char]] -> [NonEmpty [Char]]) -> [[Char]] -> [NonEmpty [Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
allNonDeprecatedFlags
completeShowOptions :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowOptions = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
flagWordBreakChars (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[Char]]
opts)
where opts :: [[Char]]
opts = [[Char]
"args", [Char]
"prog", [Char]
"editor", [Char]
"stop",
[Char]
"modules", [Char]
"bindings", [Char]
"linker", [Char]
"breaks",
[Char]
"context", [Char]
"packages", [Char]
"paths", [Char]
"language", [Char]
"imports"]
completeShowiOptions :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowiOptions = [Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
flagWordBreakChars (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
w [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[Char]
"language"])
completeHomeModuleOrFile :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile = Maybe Char
-> [Char] -> ([Char] -> m [Completion]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
Maybe Char
-> [Char] -> ([Char] -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing [Char]
filenameWordBreakChars
(([Char] -> m [Completion]) -> CompletionFunc m)
-> ([Char] -> m [Completion]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ ([Char] -> m [Completion])
-> ([Char] -> m [Completion]) -> [Char] -> m [Completion]
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m [b]) -> (a -> m [b]) -> a -> m [b]
unionComplete (([[Char]] -> [Completion]) -> m [[Char]] -> m [Completion]
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Completion) -> [[Char]] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Completion
simpleCompletion) (m [[Char]] -> m [Completion])
-> ([Char] -> m [[Char]]) -> [Char] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
forall {m :: Type -> Type}. GhcMonad m => [Char] -> m [[Char]]
listHomeModules)
[Char] -> m [Completion]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Completion]
listFiles
unionComplete :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
unionComplete :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m [b]) -> (a -> m [b]) -> a -> m [b]
unionComplete a -> m [b]
f1 a -> m [b]
f2 a
line = do
[b]
cs1 <- a -> m [b]
f1 a
line
[b]
cs2 <- a -> m [b]
f2 a
line
[b] -> m [b]
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([b]
cs1 [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
cs2)
wrapCompleter :: Monad m => String -> (String -> m [String]) -> CompletionFunc m
wrapCompleter :: forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
breakChars = (Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
(Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter' (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char]
breakChars)
wrapCompleter' :: Monad m => (Char -> Bool) -> (String -> m [String]) -> CompletionFunc m
wrapCompleter' :: forall (m :: Type -> Type).
Monad m =>
(Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter' Char -> Bool
breakPred [Char] -> m [[Char]]
fun = Maybe Char
-> (Char -> Bool) -> ([Char] -> m [Completion]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
Maybe Char
-> (Char -> Bool) -> ([Char] -> m [Completion]) -> CompletionFunc m
completeWord' Maybe Char
forall a. Maybe a
Nothing Char -> Bool
breakPred
(([Char] -> m [Completion]) -> CompletionFunc m)
-> ([Char] -> m [Completion]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [Completion]) -> m [[Char]] -> m [Completion]
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Completion) -> [[Char]] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Completion
simpleCompletion ([[Char]] -> [Completion])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nubSort) (m [[Char]] -> m [Completion])
-> ([Char] -> m [[Char]]) -> [Char] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
fun
wrapIdentCompleter :: Monad m => (String -> m [String]) -> CompletionFunc m
wrapIdentCompleter :: forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleter = (Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
(Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter' Char -> Bool
word_break_chars_pred
wrapIdentCompleterMod :: Monad m => (String -> m [String]) -> CompletionFunc m
wrapIdentCompleterMod :: forall (m :: Type -> Type).
Monad m =>
([Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleterMod = (Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
(Char -> Bool) -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter' Char -> Bool
go
where
go :: Char -> Bool
go Char
'.' = Bool
False
go Char
c = Char -> Bool
word_break_chars_pred Char
c
wrapIdentCompleterWithModifier
:: Monad m
=> String -> (Maybe Char -> String -> m [String]) -> CompletionFunc m
wrapIdentCompleterWithModifier :: forall (m :: Type -> Type).
Monad m =>
[Char] -> (Maybe Char -> [Char] -> m [[Char]]) -> CompletionFunc m
wrapIdentCompleterWithModifier [Char]
modifChars Maybe Char -> [Char] -> m [[Char]]
fun = Maybe Char
-> [Char]
-> ([Char] -> [Char] -> m [Completion])
-> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
Maybe Char
-> [Char]
-> ([Char] -> [Char] -> m [Completion])
-> CompletionFunc m
completeWordWithPrev Maybe Char
forall a. Maybe a
Nothing [Char]
word_break_chars
(([Char] -> [Char] -> m [Completion]) -> CompletionFunc m)
-> ([Char] -> [Char] -> m [Completion]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
rest -> ([[Char]] -> [Completion]) -> m [[Char]] -> m [Completion]
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Completion) -> [[Char]] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Completion
simpleCompletion ([[Char]] -> [Completion])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nubSort) (m [[Char]] -> m [Completion])
-> ([Char] -> m [[Char]]) -> [Char] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> [Char] -> m [[Char]]
fun ([Char] -> Maybe Char
getModifier [Char]
rest)
where
getModifier :: [Char] -> Maybe Char
getModifier = (Char -> Bool) -> [Char] -> Maybe Char
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char]
modifChars)
allVisibleModules :: UnitState -> [ModuleName]
allVisibleModules :: UnitState -> [ModuleName]
allVisibleModules UnitState
unit_state = UnitState -> [ModuleName]
listVisibleModuleNames UnitState
unit_state
completeExpression :: forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression = Maybe Char
-> [Char]
-> ([Char] -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
Maybe Char
-> [Char]
-> ([Char] -> m [Completion])
-> CompletionFunc m
-> CompletionFunc m
completeQuotedWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') [Char]
"\"" [Char] -> m [Completion]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Completion]
listFiles
CompletionFunc m
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier
sprintCmd, printCmd, forceCmd :: GHC.GhcMonad m => String -> m ()
sprintCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
sprintCmd = Bool -> Bool -> [Char] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Bool -> [Char] -> m ()
pprintClosureCommand Bool
False Bool
False
printCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
printCmd = Bool -> Bool -> [Char] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Bool -> [Char] -> m ()
pprintClosureCommand Bool
True Bool
False
forceCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
forceCmd = Bool -> Bool -> [Char] -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Bool -> [Char] -> m ()
pprintClosureCommand Bool
False Bool
True
stepCmd :: GhciMonad m => String -> m ()
stepCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd [Char]
arg = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":step" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
step [Char]
arg
where
step :: [Char] -> m ()
step [] = (SrcSpan -> Bool) -> SingleStep -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) SingleStep
GHC.SingleStep
step [Char]
expression = [Char] -> SingleStep -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
expression SingleStep
GHC.SingleStep m (Maybe ExecResult) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
stepLocalCmd :: GhciMonad m => String -> m ()
stepLocalCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepLocalCmd [Char]
arg = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":steplocal" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
step [Char]
arg
where
step :: [Char] -> m ()
step [Char]
expr
| Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
expr) = [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd [Char]
expr
| Bool
otherwise = do
Maybe SrcSpan
mb_span <- m (Maybe SrcSpan)
forall (m :: Type -> Type). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan
case Maybe SrcSpan
mb_span of
Maybe SrcSpan
Nothing -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd []
Just (UnhelpfulSpan UnhelpfulSpanReason
_) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn (
[Char]
":steplocal is not possible." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\nCannot determine current top-level binding after " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"a break on error / exception.\nUse :stepmodule.")
Just SrcSpan
loc -> do
GenModule Unit
md <- GenModule Unit -> Maybe (GenModule Unit) -> GenModule Unit
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> GenModule Unit
forall a. HasCallStack => [Char] -> a
panic [Char]
"stepLocalCmd") (Maybe (GenModule Unit) -> GenModule Unit)
-> m (Maybe (GenModule Unit)) -> m (GenModule Unit)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe (GenModule Unit))
forall (m :: Type -> Type).
GhcMonad m =>
m (Maybe (GenModule Unit))
getCurrentBreakModule
RealSrcSpan
current_toplevel_decl <- GenModule Unit -> SrcSpan -> m RealSrcSpan
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> SrcSpan -> m RealSrcSpan
enclosingTickSpan GenModule Unit
md SrcSpan
loc
(SrcSpan -> Bool) -> SingleStep -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue (SrcSpan -> SrcSpan -> Bool
`isSubspanOf` RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
current_toplevel_decl Maybe BufSpan
forall a. Maybe a
Strict.Nothing) SingleStep
GHC.SingleStep
stepModuleCmd :: GhciMonad m => String -> m ()
stepModuleCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepModuleCmd [Char]
arg = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":stepmodule" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
step [Char]
arg
where
step :: [Char] -> m ()
step [Char]
expr
| Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
expr) = [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd [Char]
expr
| Bool
otherwise = do
Maybe SrcSpan
mb_span <- m (Maybe SrcSpan)
forall (m :: Type -> Type). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan
case Maybe SrcSpan
mb_span of
Maybe SrcSpan
Nothing -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd []
Just SrcSpan
pan -> do
let f :: SrcSpan -> Bool
f SrcSpan
some_span = SrcSpan -> Maybe FastString
srcSpanFileName_maybe SrcSpan
pan Maybe FastString -> Maybe FastString -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> Maybe FastString
srcSpanFileName_maybe SrcSpan
some_span
(SrcSpan -> Bool) -> SingleStep -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue SrcSpan -> Bool
f SingleStep
GHC.SingleStep
enclosingTickSpan :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan
enclosingTickSpan :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> SrcSpan -> m RealSrcSpan
enclosingTickSpan GenModule Unit
_ (UnhelpfulSpan UnhelpfulSpanReason
_) = [Char] -> m RealSrcSpan
forall a. HasCallStack => [Char] -> a
panic [Char]
"enclosingTickSpan UnhelpfulSpan"
enclosingTickSpan GenModule Unit
md (RealSrcSpan RealSrcSpan
src Maybe BufSpan
_) = do
TickArray
ticks <- GenModule Unit -> m TickArray
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> m TickArray
getTickArray GenModule Unit
md
let line :: Int
line = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
src
Bool -> m ()
forall (m :: Type -> Type).
(HasCallStack, Applicative m) =>
Bool -> m ()
massert ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds TickArray
ticks) Int
line)
let enclosing_spans :: [RealSrcSpan]
enclosing_spans = [ RealSrcSpan
pan | (Int
_,RealSrcSpan
pan) <- TickArray
ticks TickArray -> Int -> [(Int, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! Int
line
, RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
pan RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
src]
RealSrcSpan -> m RealSrcSpan
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (RealSrcSpan -> m RealSrcSpan)
-> ([RealSrcSpan] -> RealSrcSpan) -> [RealSrcSpan] -> m RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan -> RealSrcSpan -> Ordering)
-> [RealSrcSpan] -> RealSrcSpan
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan ([RealSrcSpan] -> m RealSrcSpan) -> [RealSrcSpan] -> m RealSrcSpan
forall a b. (a -> b) -> a -> b
$ [RealSrcSpan]
enclosing_spans
where
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan = (RealSrcLoc -> RealSrcLoc -> Ordering)
-> (RealSrcSpan -> RealSrcLoc)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanStart (RealSrcSpan -> RealSrcSpan -> Ordering)
-> (RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall a. Semigroup a => a -> a -> a
S.<> (RealSrcLoc -> RealSrcLoc -> Ordering)
-> (RealSrcSpan -> RealSrcLoc)
-> RealSrcSpan
-> RealSrcSpan
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((RealSrcLoc -> RealSrcLoc -> Ordering)
-> RealSrcLoc -> RealSrcLoc -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) RealSrcSpan -> RealSrcLoc
realSrcSpanEnd
traceCmd :: GhciMonad m => String -> m ()
traceCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
traceCmd [Char]
arg
= [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":trace" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
tr [Char]
arg
where
tr :: [Char] -> m ()
tr [] = (SrcSpan -> Bool) -> SingleStep -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) SingleStep
GHC.RunAndLogSteps
tr [Char]
expression = [Char] -> SingleStep -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
expression SingleStep
GHC.RunAndLogSteps m (Maybe ExecResult) -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
continueCmd :: GhciMonad m => String -> m ()
continueCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
continueCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":continue" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
case [[Char]] -> Either SDoc (Maybe Int)
contSwitch ([Char] -> [[Char]]
words [Char]
argLine) of
Left SDoc
sdoc -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser SDoc
sdoc
Right Maybe Int
mbCnt -> (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
doContinue' (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) SingleStep
GHC.RunToCompletion Maybe Int
mbCnt
where
contSwitch :: [String] -> Either SDoc (Maybe Int)
contSwitch :: [[Char]] -> Either SDoc (Maybe Int)
contSwitch [ ] = Maybe Int -> Either SDoc (Maybe Int)
forall a b. b -> Either a b
Right Maybe Int
forall a. Maybe a
Nothing
contSwitch [[Char]
x] = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Either SDoc Int -> Either SDoc (Maybe Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either SDoc Int
getIgnoreCount [Char]
x
contSwitch [[Char]]
_ = SDoc -> Either SDoc (Maybe Int)
forall a b. a -> Either a b
Left (SDoc -> Either SDoc (Maybe Int))
-> SDoc -> Either SDoc (Maybe Int)
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"After ':continue' only one ignore count is allowed"
doContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()
doContinue :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue SrcSpan -> Bool
pre SingleStep
step = (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
doContinue' SrcSpan -> Bool
pre SingleStep
step Maybe Int
forall a. Maybe a
Nothing
doContinue' :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
doContinue' :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ()
doContinue' SrcSpan -> Bool
pre SingleStep
step Maybe Int
mbCnt= do
ExecResult
runResult <- (SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> Maybe Int -> m ExecResult
resume SrcSpan -> Bool
pre SingleStep
step Maybe Int
mbCnt
ExecResult
_ <- (SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt SrcSpan -> Bool
pre ExecResult
runResult
() -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
abandonCmd :: GhciMonad m => String -> m ()
abandonCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
abandonCmd = m () -> [Char] -> m ()
forall (m :: Type -> Type). MonadIO m => m () -> [Char] -> m ()
noArgs (m () -> [Char] -> m ()) -> m () -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":abandon" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
b <- m Bool
forall (m :: Type -> Type). GhcMonad m => m Bool
GHC.abandon
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"There is no computation running."
deleteCmd :: GhciMonad m => String -> m ()
deleteCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
deleteCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":delete" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
deleteSwitch ([[Char]] -> m ()) -> [[Char]] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
argLine
where
deleteSwitch :: GhciMonad m => [String] -> m ()
deleteSwitch :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
deleteSwitch [] =
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"The delete command requires at least one argument."
deleteSwitch ([Char]
"*":[[Char]]
_rest) = m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardActiveBreakPoints
deleteSwitch [[Char]]
idents = do
([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
deleteOneBreak [[Char]]
idents
where
deleteOneBreak :: GhciMonad m => String -> m ()
deleteOneBreak :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
deleteOneBreak [Char]
str
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
str = Int -> m ()
forall (m :: Type -> Type). GhciMonad m => Int -> m ()
deleteBreak ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
str)
| Bool
otherwise = () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
enableCmd :: GhciMonad m => String -> m ()
enableCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
enableCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":enable" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
enaDisaSwitch Bool
True ([[Char]] -> m ()) -> [[Char]] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
argLine
disableCmd :: GhciMonad m => String -> m ()
disableCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
disableCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":disable" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
enaDisaSwitch Bool
False ([[Char]] -> m ()) -> [[Char]] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
argLine
enaDisaSwitch :: GhciMonad m => Bool -> [String] -> m ()
enaDisaSwitch :: forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
enaDisaSwitch Bool
enaDisa [] =
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
strCmd SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"command requires at least one argument.")
where
strCmd :: [Char]
strCmd = if Bool
enaDisa then [Char]
":enable" else [Char]
":disable"
enaDisaSwitch Bool
enaDisa ([Char]
"*" : [[Char]]
_) = Bool -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
enaDisaAllBreaks Bool
enaDisa
enaDisaSwitch Bool
enaDisa [[Char]]
idents = do
([Char] -> m ()) -> [[Char]] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
enaDisaOneBreak Bool
enaDisa) [[Char]]
idents
where
enaDisaOneBreak :: GhciMonad m => Bool -> String -> m ()
enaDisaOneBreak :: forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
enaDisaOneBreak Bool
enaDisa [Char]
strId = do
Either SDoc BreakLocation
sdoc_loc <- Bool -> [Char] -> m (Either SDoc BreakLocation)
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [Char] -> m (Either SDoc BreakLocation)
checkEnaDisa Bool
enaDisa [Char]
strId
case Either SDoc BreakLocation
sdoc_loc of
Left SDoc
sdoc -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser SDoc
sdoc
Right BreakLocation
loc -> Bool -> (Int, BreakLocation) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> (Int, BreakLocation) -> m ()
enaDisaAssoc Bool
enaDisa ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
strId, BreakLocation
loc)
checkEnaDisa :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
checkEnaDisa :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [Char] -> m (Either SDoc BreakLocation)
checkEnaDisa Bool
enaDisa [Char]
strId = do
Either SDoc BreakLocation
sdoc_loc <- [Char] -> m (Either SDoc BreakLocation)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Either SDoc BreakLocation)
getBreakLoc [Char]
strId
Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either SDoc BreakLocation -> m (Either SDoc BreakLocation))
-> Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a b. (a -> b) -> a -> b
$ Either SDoc BreakLocation
sdoc_loc Either SDoc BreakLocation
-> (BreakLocation -> Either SDoc BreakLocation)
-> Either SDoc BreakLocation
forall a b. Either SDoc a -> (a -> Either SDoc b) -> Either SDoc b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [Char] -> BreakLocation -> Either SDoc BreakLocation
checkEnaDisaState Bool
enaDisa [Char]
strId
getBreakLoc :: GhciMonad m => String -> m (Either SDoc BreakLocation)
getBreakLoc :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Either SDoc BreakLocation)
getBreakLoc [Char]
strId = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
case [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
strId Maybe Int -> (Int -> Maybe BreakLocation) -> Maybe BreakLocation
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> IntMap BreakLocation -> Maybe BreakLocation)
-> IntMap BreakLocation -> Int -> Maybe BreakLocation
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntMap BreakLocation -> Maybe BreakLocation
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (GHCiState -> IntMap BreakLocation
breaks GHCiState
st) of
Maybe BreakLocation
Nothing -> Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either SDoc BreakLocation -> m (Either SDoc BreakLocation))
-> Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a b. (a -> b) -> a -> b
$ SDoc -> Either SDoc BreakLocation
forall a b. a -> Either a b
Left ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
strId SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not found")
Just BreakLocation
loc -> Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either SDoc BreakLocation -> m (Either SDoc BreakLocation))
-> Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
forall a b. (a -> b) -> a -> b
$ BreakLocation -> Either SDoc BreakLocation
forall a b. b -> Either a b
Right BreakLocation
loc
checkEnaDisaState :: Bool -> String -> BreakLocation -> Either SDoc BreakLocation
checkEnaDisaState :: Bool -> [Char] -> BreakLocation -> Either SDoc BreakLocation
checkEnaDisaState Bool
enaDisa [Char]
strId BreakLocation
loc = do
if BreakLocation -> Bool
breakEnabled BreakLocation
loc Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
enaDisa
then SDoc -> Either SDoc BreakLocation
forall a b. a -> Either a b
Left (SDoc -> Either SDoc BreakLocation)
-> SDoc -> Either SDoc BreakLocation
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
strId SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"already in desired state"
else BreakLocation -> Either SDoc BreakLocation
forall a b. b -> Either a b
Right BreakLocation
loc
enaDisaAssoc :: GhciMonad m => Bool -> (Int, BreakLocation) -> m ()
enaDisaAssoc :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> (Int, BreakLocation) -> m ()
enaDisaAssoc Bool
enaDisa (Int
intId, BreakLocation
loc) = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
BreakLocation
newLoc <- Bool -> BreakLocation -> m BreakLocation
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff Bool
enaDisa BreakLocation
loc
let new_breaks :: IntMap BreakLocation
new_breaks = Int
-> BreakLocation -> IntMap BreakLocation -> IntMap BreakLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
intId BreakLocation
newLoc (GHCiState -> IntMap BreakLocation
breaks GHCiState
st)
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState -> m ()) -> GHCiState -> m ()
forall a b. (a -> b) -> a -> b
$ GHCiState
st { breaks = new_breaks }
enaDisaAllBreaks :: GhciMonad m => Bool -> m()
enaDisaAllBreaks :: forall (m :: Type -> Type). GhciMonad m => Bool -> m ()
enaDisaAllBreaks Bool
enaDisa = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
((Int, BreakLocation) -> m ()) -> [(Int, BreakLocation)] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> (Int, BreakLocation) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> (Int, BreakLocation) -> m ()
enaDisaAssoc Bool
enaDisa) ([(Int, BreakLocation)] -> m ()) -> [(Int, BreakLocation)] -> m ()
forall a b. (a -> b) -> a -> b
$ IntMap BreakLocation -> [(Int, BreakLocation)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (IntMap BreakLocation -> [(Int, BreakLocation)])
-> IntMap BreakLocation -> [(Int, BreakLocation)]
forall a b. (a -> b) -> a -> b
$ GHCiState -> IntMap BreakLocation
breaks GHCiState
st
historyCmd :: GHC.GhcMonad m => String -> m ()
historyCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
historyCmd [Char]
arg
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
arg = Int -> m ()
forall {m :: Type -> Type}. GhcMonad m => Int -> m ()
history Int
20
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg = Int -> m ()
forall {m :: Type -> Type}. GhcMonad m => Int -> m ()
history ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg)
| Bool
otherwise = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Syntax: :history [num]"
where
history :: Int -> m ()
history Int
num = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Not stopped at a breakpoint"
(Resume
r:[Resume]
_) -> do
let hist :: [History]
hist = Resume -> [History]
GHC.resumeHistory Resume
r
([History]
took,[History]
rest) = Int -> [History] -> ([History], [History])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
num [History]
hist
case [History]
hist of
[] -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Empty history. Perhaps you forgot to use :trace?"
[History]
_ -> do
[SrcSpan]
pans <- (History -> m SrcSpan) -> [History] -> m [SrcSpan]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM History -> m SrcSpan
forall (m :: Type -> Type). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan [History]
took
let nums :: [[Char]]
nums = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"-%-3d:") [(Int
1::Int)..]
names :: [[[Char]]]
names = (History -> [[Char]]) -> [History] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map History -> [[Char]]
GHC.historyEnclosingDecls [History]
took
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat((SDoc -> SDoc -> SDoc -> SDoc)
-> [SDoc] -> [SDoc] -> [SDoc] -> [SDoc]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
(\SDoc
x SDoc
y SDoc
z -> SDoc
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
y SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
z)
(([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [[Char]]
nums)
(([[Char]] -> SDoc) -> [[[Char]]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
bold (SDoc -> SDoc) -> ([[Char]] -> SDoc) -> [[Char]] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat ([SDoc] -> SDoc) -> ([[Char]] -> [SDoc]) -> [[Char]] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
colon ([SDoc] -> [SDoc]) -> ([[Char]] -> [SDoc]) -> [[Char]] -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text) [[[Char]]]
names)
((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> (SrcSpan -> SDoc) -> SrcSpan -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [SrcSpan]
pans)))
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ if [History] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [History]
rest then [Char]
"<end of history>" else [Char]
"..."
bold :: SDoc -> SDoc
bold :: SDoc -> SDoc
bold SDoc
c | Bool
do_bold = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
start_bold SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
end_bold
| Bool
otherwise = SDoc
c
ignoreCmd :: GhciMonad m => String -> m ()
ignoreCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
ignoreCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":ignore" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Either SDoc (BreakLocation, Int)
result <- [[Char]] -> m (Either SDoc (BreakLocation, Int))
forall (m :: Type -> Type).
GhciMonad m =>
[[Char]] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch ([Char] -> [[Char]]
words [Char]
argLine)
case Either SDoc (BreakLocation, Int)
result of
Left SDoc
sdoc -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser SDoc
sdoc
Right (BreakLocation
loc, Int
count) -> do
let breakInfo :: BreakInfo
breakInfo = GenModule Unit -> Int -> BreakInfo
GHC.BreakInfo (BreakLocation -> GenModule Unit
breakModule BreakLocation
loc) (BreakLocation -> Int
breakTick BreakLocation
loc)
BreakInfo -> Int -> m ()
forall (m :: Type -> Type). GhciMonad m => BreakInfo -> Int -> m ()
setupBreakpoint BreakInfo
breakInfo Int
count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch :: forall (m :: Type -> Type).
GhciMonad m =>
[[Char]] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [[Char]
break, [Char]
count] = do
Either SDoc BreakLocation
sdoc_loc <- [Char] -> m (Either SDoc BreakLocation)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Either SDoc BreakLocation)
getBreakLoc [Char]
break
Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int)))
-> Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int))
forall a b. (a -> b) -> a -> b
$ (,) (BreakLocation -> Int -> (BreakLocation, Int))
-> Either SDoc BreakLocation
-> Either SDoc (Int -> (BreakLocation, Int))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SDoc BreakLocation
sdoc_loc Either SDoc (Int -> (BreakLocation, Int))
-> Either SDoc Int -> Either SDoc (BreakLocation, Int)
forall a b. Either SDoc (a -> b) -> Either SDoc a -> Either SDoc b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [Char] -> Either SDoc Int
getIgnoreCount [Char]
count
ignoreSwitch [[Char]]
_ = Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int)))
-> Either SDoc (BreakLocation, Int)
-> m (Either SDoc (BreakLocation, Int))
forall a b. (a -> b) -> a -> b
$ SDoc -> Either SDoc (BreakLocation, Int)
forall a b. a -> Either a b
Left (SDoc -> Either SDoc (BreakLocation, Int))
-> SDoc -> Either SDoc (BreakLocation, Int)
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Syntax: :ignore <breaknum> <count>"
getIgnoreCount :: String -> Either SDoc Int
getIgnoreCount :: [Char] -> Either SDoc Int
getIgnoreCount [Char]
str =
case [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str of
Maybe Int
Nothing -> SDoc -> Either SDoc Int
forall a b. a -> Either a b
Left (SDoc -> Either SDoc Int) -> SDoc -> Either SDoc Int
forall a b. (a -> b) -> a -> b
$ SDoc
sdocIgnore SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"is not numeric"
Just Int
cnt | Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> SDoc -> Either SDoc Int
forall a b. a -> Either a b
Left (SDoc -> Either SDoc Int) -> SDoc -> Either SDoc Int
forall a b. (a -> b) -> a -> b
$ SDoc
sdocIgnore SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"must be >= 0"
| Bool
otherwise -> Int -> Either SDoc Int
forall a b. b -> Either a b
Right Int
cnt
where
sdocIgnore :: SDoc
sdocIgnore = [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Ignore count" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
str)
setupBreakpoint :: GhciMonad m => GHC.BreakInfo -> Int -> m()
setupBreakpoint :: forall (m :: Type -> Type). GhciMonad m => BreakInfo -> Int -> m ()
setupBreakpoint BreakInfo
loc Int
count = do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
HscEnv -> BreakInfo -> Int -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
HscEnv -> BreakInfo -> Int -> m ()
GHC.setupBreakpoint HscEnv
hsc_env BreakInfo
loc Int
count
backCmd :: GhciMonad m => String -> m ()
backCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
backCmd [Char]
arg
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
arg = Int -> m ()
forall (m :: Type -> Type). GhciMonad m => Int -> m ()
back Int
1
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg = Int -> m ()
forall (m :: Type -> Type). GhciMonad m => Int -> m ()
back ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg)
| Bool
otherwise = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Syntax: :back [num]"
where
back :: Int -> m ()
back Int
num = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":back" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
([Name]
names, Int
_, SrcSpan
pan, [Char]
_) <- Int -> m ([Name], Int, SrcSpan, [Char])
forall (m :: Type -> Type).
GhcMonad m =>
Int -> m ([Name], Int, SrcSpan, [Char])
GHC.back Int
num
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Logged breakpoint at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan
[Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
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]
forwardCmd :: GhciMonad m => String -> m ()
forwardCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
forwardCmd [Char]
arg
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
arg = Int -> m ()
forall (m :: Type -> Type). GhciMonad m => Int -> m ()
forward Int
1
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg = Int -> m ()
forall (m :: Type -> Type). GhciMonad m => Int -> m ()
forward ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg)
| Bool
otherwise = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Syntax: :forward [num]"
where
forward :: Int -> m ()
forward Int
num = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":forward" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
([Name]
names, Int
ix, SrcSpan
pan, [Char]
_) <- Int -> m ([Name], Int, SrcSpan, [Char])
forall (m :: Type -> Type).
GhcMonad m =>
Int -> m ([Name], Int, SrcSpan, [Char])
GHC.forward Int
num
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ (if (Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Stopped at"
else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Logged breakpoint at") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan
[Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
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]
breakCmd :: GhciMonad m => String -> m ()
breakCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
breakCmd [Char]
argLine = [Char] -> m () -> m ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
":break" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
breakSwitch ([[Char]] -> m ()) -> [[Char]] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
words [Char]
argLine
breakSwitch :: GhciMonad m => [String] -> m ()
breakSwitch :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
breakSwitch [] = do
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"The break command requires at least one argument."
breakSwitch ([Char]
arg1:[[Char]]
rest)
| [Char] -> Bool
looksLikeModuleName [Char]
arg1 Bool -> Bool -> Bool
&& Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
rest) = do
GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
wantInterpretedModule [Char]
arg1
GenModule Unit -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> [[Char]] -> m ()
breakByModule GenModule Unit
md [[Char]]
rest
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg1 = do
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
case [InteractiveImport] -> [ModuleName]
iiModules [InteractiveImport]
imports of
(ModuleName
mn : [ModuleName]
_) -> do
GenModule Unit
md <- ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ModuleName
mn
GenModule Unit -> Int -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> [[Char]] -> m ()
breakByModuleLine GenModule Unit
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg1) [[Char]]
rest
[] -> do
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"No modules are loaded with debugging support."
| Bool
otherwise = do
[Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
breakById [Char]
arg1
breakByModule :: GhciMonad m => Module -> [String] -> m ()
breakByModule :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> [[Char]] -> m ()
breakByModule GenModule Unit
md ([Char]
arg1:[[Char]]
rest)
| (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg1 = do
GenModule Unit -> Int -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> [[Char]] -> m ()
breakByModuleLine GenModule Unit
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg1) [[Char]]
rest
breakByModule GenModule Unit
_ [[Char]]
_
= m ()
forall a. a
breakSyntax
breakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()
breakByModuleLine :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> [[Char]] -> m ()
breakByModuleLine GenModule Unit
md Int
line [[Char]]
args
| [] <- [[Char]]
args = GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet GenModule Unit
md ((TickArray -> [(Int, RealSrcSpan)]) -> m ())
-> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (Int, RealSrcSpan) -> [(Int, RealSrcSpan)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Int, RealSrcSpan) -> [(Int, RealSrcSpan)])
-> (TickArray -> Maybe (Int, RealSrcSpan))
-> TickArray
-> [(Int, RealSrcSpan)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TickArray -> Maybe (Int, RealSrcSpan)
findBreakByLine Int
line
| [[Char]
col] <- [[Char]]
args, (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
col =
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet GenModule Unit
md ((TickArray -> [(Int, RealSrcSpan)]) -> m ())
-> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (Int, RealSrcSpan) -> [(Int, RealSrcSpan)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Int, RealSrcSpan) -> [(Int, RealSrcSpan)])
-> (TickArray -> Maybe (Int, RealSrcSpan))
-> TickArray
-> [(Int, RealSrcSpan)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FastString
-> (Int, Int) -> TickArray -> Maybe (Int, RealSrcSpan)
findBreakByCoord Maybe FastString
forall a. Maybe a
Nothing (Int
line, [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
col)
| Bool
otherwise = m ()
forall a. a
breakSyntax
breakById :: GhciMonad m => String -> m ()
breakById :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
breakById [Char]
inp = do
let ([Char]
mod_str, [Char]
top_level, [Char]
fun_str) = [Char] -> ([Char], [Char], [Char])
splitIdent [Char]
inp
mod_top_lvl :: [Char]
mod_top_lvl = [Char] -> [Char] -> [Char]
combineModIdent [Char]
mod_str [Char]
top_level
Maybe (GenModule Unit)
mb_mod <- m (Maybe (GenModule Unit))
-> (SomeException -> m (Maybe (GenModule Unit)))
-> m (Maybe (GenModule Unit))
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch ([Char] -> m (Maybe (GenModule Unit))
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe (GenModule Unit))
lookupModuleInscope [Char]
mod_top_lvl)
(\(SomeException
_ :: SomeException) -> [Char] -> m (Maybe (GenModule Unit))
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe (GenModule Unit))
lookupModuleInGraph [Char]
mod_str)
Maybe SDoc
mb_err_msg <- [Char] -> [Char] -> Maybe (GenModule Unit) -> m (Maybe SDoc)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> [Char] -> Maybe (GenModule Unit) -> m (Maybe SDoc)
validateBP [Char]
mod_str [Char]
fun_str Maybe (GenModule Unit)
mb_mod
case Maybe SDoc
mb_err_msg of
Just SDoc
err_msg -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Cannot set breakpoint on" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
inp)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
err_msg
Maybe SDoc
Nothing -> do
Maybe ModuleInfo
mb_mod_info <- GenModule Unit -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Maybe ModuleInfo)
GHC.getModuleInfo (GenModule Unit -> m (Maybe ModuleInfo))
-> GenModule Unit -> m (Maybe ModuleInfo)
forall a b. (a -> b) -> a -> b
$ Maybe (GenModule Unit) -> GenModule Unit
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (GenModule Unit)
mb_mod
let modBreaks :: ModBreaks
modBreaks = case Maybe ModuleInfo
mb_mod_info of
(Just ModuleInfo
mod_info) -> ModuleInfo -> ModBreaks
GHC.modInfoModBreaks ModuleInfo
mod_info
Maybe ModuleInfo
Nothing -> ModBreaks
emptyModBreaks
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet (Maybe (GenModule Unit) -> GenModule Unit
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (GenModule Unit)
mb_mod) ((TickArray -> [(Int, RealSrcSpan)]) -> m ())
-> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ModBreaks -> TickArray -> [(Int, RealSrcSpan)]
findBreakForBind [Char]
fun_str ModBreaks
modBreaks
where
lookupModuleInscope :: GhciMonad m => String -> m (Maybe Module)
lookupModuleInscope :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe (GenModule Unit))
lookupModuleInscope [Char]
mod_top_lvl = do
NonEmpty Name
names <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
mod_top_lvl
Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (GenModule Unit) -> m (Maybe (GenModule Unit)))
-> Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a b. (a -> b) -> a -> b
$ GenModule Unit -> Maybe (GenModule Unit)
forall a. a -> Maybe a
Just (GenModule Unit -> Maybe (GenModule Unit))
-> GenModule Unit -> Maybe (GenModule Unit)
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenModule Unit) -> GenModule Unit
forall a. NonEmpty a -> a
NE.head (NonEmpty (GenModule Unit) -> GenModule Unit)
-> NonEmpty (GenModule Unit) -> GenModule Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
GHC.nameModule (Name -> GenModule Unit)
-> NonEmpty Name -> NonEmpty (GenModule Unit)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
names
lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
lookupModuleInGraph :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe (GenModule Unit))
lookupModuleInGraph [Char]
mod_str = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let hmods :: [GenModule Unit]
hmods = ModSummary -> GenModule Unit
ms_mod (ModSummary -> GenModule Unit) -> [ModSummary] -> [GenModule Unit]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph
Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (GenModule Unit) -> m (Maybe (GenModule Unit)))
-> Maybe (GenModule Unit) -> m (Maybe (GenModule Unit))
forall a b. (a -> b) -> a -> b
$ (GenModule Unit -> Bool)
-> [GenModule Unit] -> Maybe (GenModule Unit)
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
mod_str) ([Char] -> Bool)
-> (GenModule Unit -> [Char]) -> GenModule Unit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> [Char]
showModule) [GenModule Unit]
hmods
validateBP :: GhciMonad m => String -> String -> Maybe Module
-> m (Maybe SDoc)
validateBP :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> [Char] -> Maybe (GenModule Unit) -> m (Maybe SDoc)
validateBP [Char]
mod_str [Char]
fun_str Maybe (GenModule Unit)
Nothing = Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text
([Char] -> [Char] -> [Char]
combineModIdent [Char]
mod_str ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') [Char]
fun_str)))
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"not in scope"
validateBP [Char]
_ [Char]
"" (Just GenModule Unit
_) = Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Function name is missing"
validateBP [Char]
_ [Char]
fun_str (Just GenModule Unit
modl) = do
Bool
isInterpr <- GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.moduleIsInterpreted GenModule Unit
modl
(Array Int SrcSpan
_, Array Int [[Char]]
decls) <- GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
getModBreak GenModule Unit
modl
Maybe SDoc
mb_err_msg <- case Bool
isInterpr of
Bool
False -> Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenModule Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule Unit
modl)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"is not interpreted"
Bool
True -> case [Char]
fun_str [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` ([[Char]] -> [Char]
declPath ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Int [[Char]] -> [[[Char]]]
forall i e. Array i e -> [e]
elems Array Int [[Char]]
decls) of
Bool
False -> Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe SDoc -> m (Maybe SDoc)) -> Maybe SDoc -> m (Maybe SDoc)
forall a b. (a -> b) -> a -> b
$ SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"No breakpoint found for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
fun_str)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"in module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenModule Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule Unit
modl)
Bool
True -> Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe SDoc
forall a. Maybe a
Nothing
Maybe SDoc -> m (Maybe SDoc)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe SDoc
mb_err_msg
breakSyntax :: a
breakSyntax :: forall a. a
breakSyntax = GhcException -> a
forall a. GhcException -> a
throwGhcException (GhcException -> a) -> GhcException -> a
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
CmdLineError ([Char]
"Syntax: :break [<mod>.]<func>[.<func>]\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" :break [<mod>] <line> [<column>]")
findBreakAndSet :: GhciMonad m
=> Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet GenModule Unit
md TickArray -> [(Int, RealSrcSpan)]
lookupTickTree = do
TickArray
tickArray <- GenModule Unit -> m TickArray
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> m TickArray
getTickArray GenModule Unit
md
case TickArray -> [(Int, RealSrcSpan)]
lookupTickTree TickArray
tickArray of
[] -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"No breakpoints found at that location."
[(Int, RealSrcSpan)]
some -> ((Int, RealSrcSpan) -> m ()) -> [(Int, RealSrcSpan)] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, RealSrcSpan) -> m ()
breakAt [(Int, RealSrcSpan)]
some
where
breakAt :: (Int, RealSrcSpan) -> m ()
breakAt (Int
tick, RealSrcSpan
pan) = do
GenModule Unit -> Int -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> Bool -> m ()
setBreakFlag GenModule Unit
md Int
tick Bool
True
(Bool
alreadySet, Int
nm) <-
BreakLocation -> m (Bool, Int)
forall (m :: Type -> Type).
GhciMonad m =>
BreakLocation -> m (Bool, Int)
recordBreak (BreakLocation -> m (Bool, Int)) -> BreakLocation -> m (Bool, Int)
forall a b. (a -> b) -> a -> b
$ BreakLocation
{ breakModule :: GenModule Unit
breakModule = GenModule Unit
md
, breakLoc :: SrcSpan
breakLoc = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
pan Maybe BufSpan
forall a. Maybe a
Strict.Nothing
, breakTick :: Int
breakTick = Int
tick
, onBreakCmd :: [Char]
onBreakCmd = [Char]
""
, breakEnabled :: Bool
breakEnabled = Bool
True
}
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Breakpoint " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nm SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
if Bool
alreadySet
then [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" was already set at " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
pan
else [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" activated at " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
pan
findBreakByLine :: Int -> TickArray -> Maybe (BreakIndex,RealSrcSpan)
findBreakByLine :: Int -> TickArray -> Maybe (Int, RealSrcSpan)
findBreakByLine Int
line TickArray
arr
| Bool -> Bool
not ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds TickArray
arr) Int
line) = Maybe (Int, RealSrcSpan)
forall a. Maybe a
Nothing
| Bool
otherwise =
[(Int, RealSrcSpan)] -> Maybe (Int, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((Int, RealSrcSpan) -> (Int, RealSrcSpan) -> Ordering)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((Int, RealSrcSpan) -> RealSrcSpan)
-> (Int, RealSrcSpan)
-> (Int, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(Int, RealSrcSpan)]
comp) Maybe (Int, RealSrcSpan)
-> Maybe (Int, RealSrcSpan) -> Maybe (Int, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
`mplus`
[(Int, RealSrcSpan)] -> Maybe (Int, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((Int, RealSrcSpan) -> (Int, RealSrcSpan) -> Ordering)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((Int, RealSrcSpan) -> RealSrcSpan)
-> (Int, RealSrcSpan)
-> (Int, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(Int, RealSrcSpan)]
incomp) Maybe (Int, RealSrcSpan)
-> Maybe (Int, RealSrcSpan) -> Maybe (Int, RealSrcSpan)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
`mplus`
[(Int, RealSrcSpan)] -> Maybe (Int, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((Int, RealSrcSpan) -> (Int, RealSrcSpan) -> Ordering)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan -> RealSrcSpan -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((Int, RealSrcSpan) -> RealSrcSpan)
-> (Int, RealSrcSpan)
-> (Int, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(Int, RealSrcSpan)]
ticks)
where
ticks :: [(Int, RealSrcSpan)]
ticks = TickArray
arr TickArray -> Int -> [(Int, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! Int
line
starts_here :: [(Int, RealSrcSpan)]
starts_here = [ (Int
ix,RealSrcSpan
pan) | (Int
ix, RealSrcSpan
pan) <- [(Int, RealSrcSpan)]
ticks,
RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
pan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line ]
([(Int, RealSrcSpan)]
comp, [(Int, RealSrcSpan)]
incomp) = ((Int, RealSrcSpan) -> Bool)
-> [(Int, RealSrcSpan)]
-> ([(Int, RealSrcSpan)], [(Int, RealSrcSpan)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Int, RealSrcSpan) -> Bool
ends_here [(Int, RealSrcSpan)]
starts_here
where ends_here :: (Int, RealSrcSpan) -> Bool
ends_here (Int
_,RealSrcSpan
pan) = RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
pan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line
findBreakForBind :: String -> GHC.ModBreaks -> TickArray
-> [(BreakIndex,RealSrcSpan)]
findBreakForBind :: [Char] -> ModBreaks -> TickArray -> [(Int, RealSrcSpan)]
findBreakForBind [Char]
str_name ModBreaks
modbreaks TickArray
_ = ((Int, RealSrcSpan) -> Bool)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Int, RealSrcSpan) -> Bool) -> (Int, RealSrcSpan) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, RealSrcSpan) -> Bool
enclosed) [(Int, RealSrcSpan)]
ticks
where
ticks :: [(Int, RealSrcSpan)]
ticks = [ (Int
index, RealSrcSpan
span)
| (Int
index, [[Char]]
decls) <- Array Int [[Char]] -> [(Int, [[Char]])]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (ModBreaks -> Array Int [[Char]]
GHC.modBreaks_decls ModBreaks
modbreaks),
[Char]
str_name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]] -> [Char]
declPath [[Char]]
decls,
RealSrcSpan RealSrcSpan
span Maybe BufSpan
_ <- [ModBreaks -> Array Int SrcSpan
GHC.modBreaks_locs ModBreaks
modbreaks Array Int SrcSpan -> Int -> SrcSpan
forall i e. Ix i => Array i e -> i -> e
! Int
index] ]
enclosed :: (Int, RealSrcSpan) -> Bool
enclosed (Int
_,RealSrcSpan
sp0) = ((Int, RealSrcSpan) -> Bool) -> [(Int, RealSrcSpan)] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Int, RealSrcSpan) -> Bool
subspan [(Int, RealSrcSpan)]
ticks
where subspan :: (Int, RealSrcSpan) -> Bool
subspan (Int
_,RealSrcSpan
sp) = RealSrcSpan
sp RealSrcSpan -> RealSrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= RealSrcSpan
sp0 Bool -> Bool -> Bool
&&
RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
sp RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
sp0 Bool -> Bool -> Bool
&&
RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
sp0 RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
sp
findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
-> Maybe (BreakIndex,RealSrcSpan)
findBreakByCoord :: Maybe FastString
-> (Int, Int) -> TickArray -> Maybe (Int, RealSrcSpan)
findBreakByCoord Maybe FastString
mb_file (Int
line, Int
col) TickArray
arr
| Bool -> Bool
not ((Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (TickArray -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds TickArray
arr) Int
line) = Maybe (Int, RealSrcSpan)
forall a. Maybe a
Nothing
| Bool
otherwise =
[(Int, RealSrcSpan)] -> Maybe (Int, RealSrcSpan)
forall a. [a] -> Maybe a
listToMaybe (((Int, RealSrcSpan) -> (Int, RealSrcSpan) -> Ordering)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((RealSrcSpan -> RealSrcSpan -> Ordering)
-> RealSrcSpan -> RealSrcSpan -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((Int, RealSrcSpan) -> RealSrcSpan)
-> (Int, RealSrcSpan)
-> (Int, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(Int, RealSrcSpan)]
contains [(Int, RealSrcSpan)]
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. [a] -> [a] -> [a]
++
((Int, RealSrcSpan) -> (Int, RealSrcSpan) -> Ordering)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (RealSrcSpan -> RealSrcSpan -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> RealSrcSpan -> Ordering)
-> ((Int, RealSrcSpan) -> RealSrcSpan)
-> (Int, RealSrcSpan)
-> (Int, RealSrcSpan)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, RealSrcSpan) -> RealSrcSpan
forall a b. (a, b) -> b
snd) [(Int, RealSrcSpan)]
after_here)
where
ticks :: [(Int, RealSrcSpan)]
ticks = TickArray
arr TickArray -> Int -> [(Int, RealSrcSpan)]
forall i e. Ix i => Array i e -> i -> e
! Int
line
contains :: [(Int, RealSrcSpan)]
contains = [ (Int, RealSrcSpan)
tick | tick :: (Int, RealSrcSpan)
tick@(Int
_,RealSrcSpan
pan) <- [(Int, RealSrcSpan)]
ticks, RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
pan Maybe BufSpan
forall a. Maybe a
Strict.Nothing SrcSpan -> (Int, Int) -> Bool
`spans` (Int
line,Int
col),
RealSrcSpan -> Bool
is_correct_file RealSrcSpan
pan ]
is_correct_file :: RealSrcSpan -> Bool
is_correct_file RealSrcSpan
pan
| Just FastString
f <- Maybe FastString
mb_file = RealSrcSpan -> FastString
GHC.srcSpanFile RealSrcSpan
pan FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
f
| Bool
otherwise = Bool
True
after_here :: [(Int, RealSrcSpan)]
after_here = [ (Int, RealSrcSpan)
tick | tick :: (Int, RealSrcSpan)
tick@(Int
_,RealSrcSpan
pan) <- [(Int, RealSrcSpan)]
ticks,
RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
pan Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line,
RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
pan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
col ]
do_bold :: Bool
do_bold :: Bool
do_bold = ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` IO [Char] -> [Char]
forall a. IO a -> a
unsafePerformIO IO [Char]
mTerm) ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
`any` [[Char]
"xterm", [Char]
"linux"]
where mTerm :: IO [Char]
mTerm = [Char] -> IO [Char]
System.Environment.getEnv [Char]
"TERM"
IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
"TERM not set"
start_bold :: String
start_bold :: [Char]
start_bold = [Char]
"\ESC[1m"
end_bold :: String
end_bold :: [Char]
end_bold = [Char]
"\ESC[0m"
whereCmd :: GHC.GhcMonad m => String -> m ()
whereCmd :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
whereCmd = m () -> [Char] -> m ()
forall (m :: Type -> Type). MonadIO m => m () -> [Char] -> m ()
noArgs (m () -> [Char] -> m ()) -> m () -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ do
Maybe [[Char]]
mstrs <- m (Maybe [[Char]])
forall (m :: Type -> Type). GhcMonad m => m (Maybe [[Char]])
getCallStackAtCurrentBreakpoint
case Maybe [[Char]]
mstrs of
Maybe [[Char]]
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just [[Char]]
strs -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([[Char]] -> [Char]
renderStack [[Char]]
strs)
listCmd :: GhciMonad m => String -> m ()
listCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
listCmd [Char]
"" = do
Maybe SrcSpan
mb_span <- m (Maybe SrcSpan)
forall (m :: Type -> Type). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan
case Maybe SrcSpan
mb_span of
Maybe SrcSpan
Nothing ->
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Not stopped at a breakpoint; nothing to list"
Just (RealSrcSpan RealSrcSpan
pan Maybe BufSpan
_) ->
RealSrcSpan -> Bool -> m ()
forall (m :: Type -> Type).
MonadIO m =>
RealSrcSpan -> Bool -> m ()
listAround RealSrcSpan
pan Bool
True
Just pan :: SrcSpan
pan@(UnhelpfulSpan UnhelpfulSpanReason
_) ->
do [Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
panic [Char]
"No resumes"
(Resume
r:[Resume]
_) ->
do let traceIt :: SDoc
traceIt = case Resume -> [History]
GHC.resumeHistory Resume
r of
[] -> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"rerunning with :trace,"
[History]
_ -> SDoc
forall doc. IsOutput doc => doc
empty
doWhat :: SDoc
doWhat = SDoc
traceIt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
":back then :list"
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Unable to list source for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Try" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doWhat)
listCmd [Char]
str = [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
list2 ([Char] -> [[Char]]
words [Char]
str)
list2 :: GhciMonad m => [String] -> m ()
list2 :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
list2 [[Char]
arg] | (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg = do
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
case [InteractiveImport] -> [ModuleName]
iiModules [InteractiveImport]
imports of
[] -> IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"No module to list"
(ModuleName
mn : [ModuleName]
_) -> do
GenModule Unit
md <- ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ModuleName
mn
GenModule Unit -> Int -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> Int -> m ()
listModuleLine GenModule Unit
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg)
list2 [[Char]
arg1,[Char]
arg2] | [Char] -> Bool
looksLikeModuleName [Char]
arg1, (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
arg2 = do
GenModule Unit
md <- [Char] -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
wantInterpretedModule [Char]
arg1
GenModule Unit -> Int -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> Int -> m ()
listModuleLine GenModule Unit
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg2)
list2 [[Char]
arg] = do
(Name -> SDoc -> m ()) -> [Char] -> (Name -> m ()) -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(Name -> SDoc -> m ()) -> [Char] -> (Name -> m ()) -> m ()
wantNameFromInterpretedModule Name -> SDoc -> m ()
forall {m :: Type -> Type} {a}.
(GhcMonad m, Outputable a) =>
a -> SDoc -> m ()
noCanDo [Char]
arg ((Name -> m ()) -> m ()) -> (Name -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
let loc :: SrcLoc
loc = SrcSpan -> SrcLoc
GHC.srcSpanStart (Name -> SrcSpan
GHC.nameSrcSpan Name
name)
case SrcLoc
loc of
RealSrcLoc RealSrcLoc
l Maybe BufPos
_ ->
do TickArray
tickArray <- Bool -> m TickArray -> m TickArray
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
name) (m TickArray -> m TickArray) -> m TickArray -> m TickArray
forall a b. (a -> b) -> a -> b
$
GenModule Unit -> m TickArray
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> m TickArray
getTickArray ((() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
GHC.nameModule Name
name)
let mb_span :: Maybe (Int, RealSrcSpan)
mb_span = Maybe FastString
-> (Int, Int) -> TickArray -> Maybe (Int, RealSrcSpan)
findBreakByCoord (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (RealSrcLoc -> FastString
GHC.srcLocFile RealSrcLoc
l))
(RealSrcLoc -> Int
GHC.srcLocLine RealSrcLoc
l, RealSrcLoc -> Int
GHC.srcLocCol RealSrcLoc
l)
TickArray
tickArray
case Maybe (Int, RealSrcSpan)
mb_span of
Maybe (Int, RealSrcSpan)
Nothing -> RealSrcSpan -> Bool -> m ()
forall (m :: Type -> Type).
MonadIO m =>
RealSrcSpan -> Bool -> m ()
listAround (RealSrcLoc -> RealSrcSpan
realSrcLocSpan RealSrcLoc
l) Bool
False
Just (Int
_, RealSrcSpan
pan) -> RealSrcSpan -> Bool -> m ()
forall (m :: Type -> Type).
MonadIO m =>
RealSrcSpan -> Bool -> m ()
listAround RealSrcSpan
pan Bool
False
UnhelpfulLoc FastString
_ ->
Name -> SDoc -> m ()
forall {m :: Type -> Type} {a}.
(GhcMonad m, Outputable a) =>
a -> SDoc -> m ()
noCanDo Name
name (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"can't find its location: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcLoc
loc
where
noCanDo :: a -> SDoc -> m ()
noCanDo a
n SDoc
why = SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"cannot list source code for " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
": " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
why
list2 [[Char]]
_other =
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"syntax: :list [<line> | <module> <line> | <identifier>]"
listModuleLine :: GHC.GhcMonad m => Module -> Int -> m ()
listModuleLine :: forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> Int -> m ()
listModuleLine GenModule Unit
modl Int
line = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let this :: Maybe ModSummary
this = ModuleGraph -> GenModule Unit -> Maybe ModSummary
GHC.mgLookupModule ModuleGraph
graph GenModule Unit
modl
case Maybe ModSummary
this of
Maybe ModSummary
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
panic [Char]
"listModuleLine"
Just ModSummary
summ -> do
let filename :: [Char]
filename = [Char] -> Maybe [Char] -> [Char]
forall a. HasCallStack => [Char] -> Maybe a -> a
expectJust [Char]
"listModuleLine" (ModLocation -> Maybe [Char]
ml_hs_file (ModSummary -> ModLocation
GHC.ms_location ModSummary
summ))
loc :: RealSrcLoc
loc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc ([Char] -> FastString
mkFastString ([Char]
filename)) Int
line Int
0
RealSrcSpan -> Bool -> m ()
forall (m :: Type -> Type).
MonadIO m =>
RealSrcSpan -> Bool -> m ()
listAround (RealSrcLoc -> RealSrcSpan
realSrcLocSpan RealSrcLoc
loc) Bool
False
listAround :: MonadIO m => RealSrcSpan -> Bool -> m ()
listAround :: forall (m :: Type -> Type).
MonadIO m =>
RealSrcSpan -> Bool -> m ()
listAround RealSrcSpan
pan Bool
do_highlight = do
ByteString
contents <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile (FastString -> [Char]
unpackFS FastString
file)
let ls :: [ByteString]
ls = Char -> ByteString -> [ByteString]
BS.split Char
'\n' (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') ByteString
contents
ls' :: [ByteString]
ls' = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take (Int
line2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pad_before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pad_after) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop (Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pad_before) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
ls
fst_line :: Int
fst_line = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pad_before)
line_nos :: [Int]
line_nos = [ Int
fst_line .. ]
highlighted :: [ByteString -> ByteString]
highlighted | Bool
do_highlight = (Int -> ByteString -> ByteString -> ByteString)
-> [Int] -> [ByteString] -> [ByteString -> ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ByteString -> ByteString -> ByteString
highlight [Int]
line_nos [ByteString]
ls'
| Bool
otherwise = [\ByteString
p -> [ByteString] -> ByteString
BS.concat[ByteString
p,ByteString
l] | ByteString
l <- [ByteString]
ls']
bs_line_nos :: [ByteString]
bs_line_nos = [ [Char] -> ByteString
BS.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") | Int
l <- [Int]
line_nos ]
prefixed :: [ByteString]
prefixed = ((ByteString -> ByteString) -> ByteString -> ByteString)
-> [ByteString -> ByteString] -> [ByteString] -> [ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
($) [ByteString -> ByteString]
highlighted [ByteString]
bs_line_nos
output :: ByteString
output = ByteString -> [ByteString] -> ByteString
BS.intercalate ([Char] -> ByteString
BS.pack [Char]
"\n") [ByteString]
prefixed
let utf8Decoded :: [Char]
utf8Decoded = ByteString -> [Char]
utf8DecodeByteString ByteString
output
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
utf8Decoded
where
file :: FastString
file = RealSrcSpan -> FastString
GHC.srcSpanFile RealSrcSpan
pan
line1 :: Int
line1 = RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
pan
col1 :: Int
col1 = RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
pan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
line2 :: Int
line2 = RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
pan
col2 :: Int
col2 = RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
pan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
pad_before :: Int
pad_before | Int
line1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int
0
| Bool
otherwise = Int
1
pad_after :: Int
pad_after = Int
1
highlight :: Int -> ByteString -> ByteString -> ByteString
highlight | Bool
do_bold = Int -> ByteString -> ByteString -> ByteString
highlight_bold
| Bool
otherwise = Int -> ByteString -> ByteString -> ByteString
highlight_carets
highlight_bold :: Int -> ByteString -> ByteString -> ByteString
highlight_bold Int
no ByteString
line ByteString
prefix
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2
= let (ByteString
a,ByteString
r) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
col1 ByteString
line
(ByteString
b,ByteString
c) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
col2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
col1) ByteString
r
in
[ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
a,[Char] -> ByteString
BS.pack [Char]
start_bold,ByteString
b,[Char] -> ByteString
BS.pack [Char]
end_bold,ByteString
c]
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1
= let (ByteString
a,ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
col1 ByteString
line in
[ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
a, [Char] -> ByteString
BS.pack [Char]
start_bold, ByteString
b]
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2
= let (ByteString
a,ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
col2 ByteString
line in
[ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
a, [Char] -> ByteString
BS.pack [Char]
end_bold, ByteString
b]
| Bool
otherwise = [ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
line]
highlight_carets :: Int -> ByteString -> ByteString -> ByteString
highlight_carets Int
no ByteString
line ByteString
prefix
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 Bool -> Bool -> Bool
&& Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2
= [ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
line, ByteString
nl, ByteString
indent, Int -> Char -> ByteString
BS.replicate Int
col1 Char
' ',
Int -> Char -> ByteString
BS.replicate (Int
col2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
col1) Char
'^']
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1
= [ByteString] -> ByteString
BS.concat [ByteString
indent, Int -> Char -> ByteString
BS.replicate (Int
col1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Char
' ', [Char] -> ByteString
BS.pack [Char]
"vv", ByteString
nl,
ByteString
prefix, ByteString
line]
| Int
no Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2
= [ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
line, ByteString
nl, ByteString
indent, Int -> Char -> ByteString
BS.replicate Int
col2 Char
' ',
[Char] -> ByteString
BS.pack [Char]
"^^"]
| Bool
otherwise = [ByteString] -> ByteString
BS.concat [ByteString
prefix, ByteString
line]
where
indent :: ByteString
indent = [Char] -> ByteString
BS.pack ([Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
no)) Char
' ')
nl :: ByteString
nl = Char -> ByteString
BS.singleton Char
'\n'
getTickArray :: GhciMonad m => Module -> m TickArray
getTickArray :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> m TickArray
getTickArray GenModule Unit
modl = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let arrmap :: ModuleEnv TickArray
arrmap = GHCiState -> ModuleEnv TickArray
tickarrays GHCiState
st
case ModuleEnv TickArray -> GenModule Unit -> Maybe TickArray
forall a. ModuleEnv a -> GenModule Unit -> Maybe a
lookupModuleEnv ModuleEnv TickArray
arrmap GenModule Unit
modl of
Just TickArray
arr -> TickArray -> m TickArray
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return TickArray
arr
Maybe TickArray
Nothing -> do
(Array Int SrcSpan
ticks, Array Int [[Char]]
_) <- GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
getModBreak GenModule Unit
modl
let arr :: TickArray
arr = [(Int, SrcSpan)] -> TickArray
mkTickArray (Array Int SrcSpan -> [(Int, SrcSpan)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array Int SrcSpan
ticks)
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{tickarrays = extendModuleEnv arrmap modl arr}
TickArray -> m TickArray
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return TickArray
arr
discardTickArrays :: GhciMonad m => m ()
discardTickArrays :: forall (m :: Type -> Type). GhciMonad m => m ()
discardTickArrays = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st {tickarrays = emptyModuleEnv})
mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
mkTickArray :: [(Int, SrcSpan)] -> TickArray
mkTickArray [(Int, SrcSpan)]
ticks
= ([(Int, RealSrcSpan)]
-> (Int, RealSrcSpan) -> [(Int, RealSrcSpan)])
-> [(Int, RealSrcSpan)]
-> (Int, Int)
-> [(Int, (Int, RealSrcSpan))]
-> TickArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (((Int, RealSrcSpan)
-> [(Int, RealSrcSpan)] -> [(Int, RealSrcSpan)])
-> [(Int, RealSrcSpan)]
-> (Int, RealSrcSpan)
-> [(Int, RealSrcSpan)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] (Int
1, Int
max_line)
[ (Int
line, (Int
nm,RealSrcSpan
pan)) | (Int
nm,RealSrcSpan RealSrcSpan
pan Maybe BufSpan
_) <- [(Int, SrcSpan)]
ticks, Int
line <- RealSrcSpan -> [Int]
srcSpanLines RealSrcSpan
pan ]
where
max_line :: Int
max_line = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [ RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
sp | (Int
_, RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_) <- [(Int, SrcSpan)]
ticks ]
srcSpanLines :: RealSrcSpan -> [Int]
srcSpanLines RealSrcSpan
pan = [ RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
pan .. RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
pan ]
discardActiveBreakPoints :: GhciMonad m => m ()
discardActiveBreakPoints :: forall (m :: Type -> Type). GhciMonad m => m ()
discardActiveBreakPoints = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
(BreakLocation -> m BreakLocation) -> IntMap BreakLocation -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> BreakLocation -> m BreakLocation
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff Bool
False) (IntMap BreakLocation -> m ()) -> IntMap BreakLocation -> m ()
forall a b. (a -> b) -> a -> b
$ GHCiState -> IntMap BreakLocation
breaks GHCiState
st
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState -> m ()) -> GHCiState -> m ()
forall a b. (a -> b) -> a -> b
$ GHCiState
st { breaks = IntMap.empty }
discardInterfaceCache :: GhciMonad m => m ()
discardInterfaceCache :: forall (m :: Type -> Type). GhciMonad m => m ()
discardInterfaceCache =
m [CachedIface] -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (IO [CachedIface] -> m [CachedIface]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [CachedIface] -> m [CachedIface])
-> (GHCiState -> IO [CachedIface]) -> GHCiState -> m [CachedIface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIfaceCache -> IO [CachedIface]
iface_clearCache (ModIfaceCache -> IO [CachedIface])
-> (GHCiState -> ModIfaceCache) -> GHCiState -> IO [CachedIface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCiState -> ModIfaceCache
ifaceCache (GHCiState -> m [CachedIface]) -> m GHCiState -> m [CachedIface]
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState)
clearHPTs :: GhciMonad m => m ()
clearHPTs :: forall (m :: Type -> Type). GhciMonad m => m ()
clearHPTs = do
let pruneHomeUnitEnv :: HomeUnitEnv -> HomeUnitEnv
pruneHomeUnitEnv HomeUnitEnv
hme = HomeUnitEnv
hme { homeUnitEnv_hpt = emptyHomePackageTable }
discardMG :: HscEnv -> HscEnv
discardMG HscEnv
hsc = HscEnv
hsc { hsc_mod_graph = GHC.emptyMG }
(HscEnv -> HscEnv) -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(HscEnv -> HscEnv) -> m ()
modifySession (HscEnv -> HscEnv
discardMG (HscEnv -> HscEnv) -> (HscEnv -> HscEnv) -> HscEnv -> HscEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> HscEnv
discardIC (HscEnv -> HscEnv) -> (HscEnv -> HscEnv) -> HscEnv -> HscEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv
hscUpdateHUG ((HomeUnitEnv -> HomeUnitEnv) -> HomeUnitGraph -> HomeUnitGraph
forall v. (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v
unitEnv_map HomeUnitEnv -> HomeUnitEnv
pruneHomeUnitEnv))
disableUnusedPackages :: GhciMonad m => m ()
disableUnusedPackages :: forall (m :: Type -> Type). GhciMonad m => m ()
disableUnusedPackages = Bool -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [[Char]] -> m ()
newDynFlags Bool
False [[Char]
"-Wno-unused-packages"]
deleteBreak :: GhciMonad m => Int -> m ()
deleteBreak :: forall (m :: Type -> Type). GhciMonad m => Int -> m ()
deleteBreak Int
identity = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let oldLocations :: IntMap BreakLocation
oldLocations = GHCiState -> IntMap BreakLocation
breaks GHCiState
st
case Int -> IntMap BreakLocation -> Maybe BreakLocation
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
identity IntMap BreakLocation
oldLocations of
Maybe BreakLocation
Nothing -> SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
identity SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"does not exist")
Just BreakLocation
loc -> do
BreakLocation
_ <- (Bool -> BreakLocation -> m BreakLocation
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff Bool
False) BreakLocation
loc
let rest :: IntMap BreakLocation
rest = Int -> IntMap BreakLocation -> IntMap BreakLocation
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
identity IntMap BreakLocation
oldLocations
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState (GHCiState -> m ()) -> GHCiState -> m ()
forall a b. (a -> b) -> a -> b
$ GHCiState
st { breaks = rest }
turnBreakOnOff :: GhciMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff Bool
onOff BreakLocation
loc
| Bool
onOff Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== BreakLocation -> Bool
breakEnabled BreakLocation
loc = BreakLocation -> m BreakLocation
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BreakLocation
loc
| Bool
otherwise = do
GenModule Unit -> Int -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> Bool -> m ()
setBreakFlag (BreakLocation -> GenModule Unit
breakModule BreakLocation
loc) (BreakLocation -> Int
breakTick BreakLocation
loc) Bool
onOff
BreakLocation -> m BreakLocation
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BreakLocation
loc { breakEnabled = onOff }
getModBreak :: GHC.GhcMonad m
=> Module -> m (Array Int SrcSpan, Array Int [String])
getModBreak :: forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Array Int SrcSpan, Array Int [[Char]])
getModBreak GenModule Unit
m = do
ModuleInfo
mod_info <- ModuleInfo -> Maybe ModuleInfo -> ModuleInfo
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ModuleInfo
forall a. HasCallStack => [Char] -> a
panic [Char]
"getModBreak") (Maybe ModuleInfo -> ModuleInfo)
-> m (Maybe ModuleInfo) -> m ModuleInfo
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GenModule Unit -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
GenModule Unit -> m (Maybe ModuleInfo)
GHC.getModuleInfo GenModule Unit
m
let modBreaks :: ModBreaks
modBreaks = ModuleInfo -> ModBreaks
GHC.modInfoModBreaks ModuleInfo
mod_info
let ticks :: Array Int SrcSpan
ticks = ModBreaks -> Array Int SrcSpan
GHC.modBreaks_locs ModBreaks
modBreaks
let decls :: Array Int [[Char]]
decls = ModBreaks -> Array Int [[Char]]
GHC.modBreaks_decls ModBreaks
modBreaks
(Array Int SrcSpan, Array Int [[Char]])
-> m (Array Int SrcSpan, Array Int [[Char]])
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Array Int SrcSpan
ticks, Array Int [[Char]]
decls)
setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
setBreakFlag :: forall (m :: Type -> Type).
GhciMonad m =>
GenModule Unit -> Int -> Bool -> m ()
setBreakFlag GenModule Unit
md Int
ix Bool
enaDisa = do
let enaDisaToCount :: Bool -> Int
enaDisaToCount Bool
True = Int
breakOn
enaDisaToCount Bool
False = Int
breakOff
BreakInfo -> Int -> m ()
forall (m :: Type -> Type). GhciMonad m => BreakInfo -> Int -> m ()
setupBreakpoint (GenModule Unit -> Int -> BreakInfo
GHC.BreakInfo GenModule Unit
md Int
ix) (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Int
enaDisaToCount Bool
enaDisa
handler :: GhciMonad m => SomeException -> m Bool
handler :: forall (m :: Type -> Type). GhciMonad m => SomeException -> m Bool
handler SomeException
exception = do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
m Bool -> m Bool
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m a
withSignalHandlers (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
(SomeException -> m Bool) -> m Bool -> m Bool
forall (m :: Type -> Type) a.
(HasLogger m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle SomeException -> m Bool
forall (m :: Type -> Type). GhciMonad m => SomeException -> m Bool
handler (SomeException -> m ()
forall (m :: Type -> Type). MonadIO m => SomeException -> m ()
showException SomeException
exception m () -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False)
showException :: MonadIO m => SomeException -> m ()
showException :: forall (m :: Type -> Type). MonadIO m => SomeException -> m ()
showException SomeException
se =
IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (CmdLineError [Char]
s) -> [Char] -> IO ()
putException [Char]
s
Just GhcException
other_ghc_ex -> [Char] -> IO ()
putException (GhcException -> [Char]
forall a. Show a => a -> [Char]
show GhcException
other_ghc_ex)
Maybe GhcException
Nothing ->
case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just AsyncException
UserInterrupt -> [Char] -> IO ()
putException [Char]
"Interrupted."
Maybe AsyncException
_ -> [Char] -> IO ()
putException ([Char]
"*** Exception: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
se)
where
putException :: [Char] -> IO ()
putException = Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
failIfExprEvalMode :: GhciMonad m => m ()
failIfExprEvalMode :: forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode = do
GHCiState
s <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (GHCiState -> Bool
ghc_e GHCiState
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall a. IO a -> m a
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))
printErrAndMaybeExit :: (GhciMonad m, MonadIO m, HasLogger m) => SourceError -> m ()
printErrAndMaybeExit :: forall (m :: Type -> Type).
(GhciMonad m, MonadIO m, HasLogger m) =>
SourceError -> m ()
printErrAndMaybeExit = (m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
failIfExprEvalMode) (m () -> m ()) -> (SourceError -> m ()) -> SourceError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> m ()
forall (m :: Type -> Type).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException
ghciHandle :: (HasLogger m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
ghciHandle :: forall (m :: Type -> Type) a.
(HasLogger m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle SomeException -> m a
h m a
m = ((forall a. m a -> m a) -> m a) -> m a
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: Type -> Type) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
!Logger
log <- m Logger
forall (m :: Type -> Type). HasLogger m => m Logger
getLogger
m a -> (SomeException -> m a) -> m a
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a -> m a
forall a. m a -> m a
restore (Logger -> m a -> m a
forall (m :: Type -> Type) a.
ExceptionMonad m =>
Logger -> m a -> m a
GHC.prettyPrintGhcErrors Logger
log m a
m)) ((SomeException -> m a) -> m a) -> (SomeException -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> m a -> m a
forall a. m a -> m a
restore (SomeException -> m a
h SomeException
e)
ghciTry :: ExceptionMonad m => m a -> m (Either SomeException a)
ghciTry :: forall (m :: Type -> Type) a.
ExceptionMonad m =>
m a -> m (Either SomeException a)
ghciTry m a
m = (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right m a
m m (Either SomeException a)
-> (SomeException -> m (Either SomeException a))
-> m (Either SomeException a)
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> Either SomeException a -> m (Either SomeException a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e
tryBool :: ExceptionMonad m => m a -> m Bool
tryBool :: forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m Bool
tryBool m a
m = do
Either SomeException a
r <- m a -> m (Either SomeException a)
forall (m :: Type -> Type) a.
ExceptionMonad m =>
m a -> m (Either SomeException a)
ghciTry m a
m
case Either SomeException a
r of
Left SomeException
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
Right a
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
lookupModule :: GHC.GhcMonad m => String -> m Module
lookupModule :: forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
lookupModule [Char]
mName = ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ([Char] -> ModuleName
GHC.mkModuleName [Char]
mName)
lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
lookupModuleName :: forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ModuleName
mName = PkgQual -> ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
PkgQual -> ModuleName -> m (GenModule Unit)
GHC.lookupQualifiedModule PkgQual
NoPkgQual ModuleName
mName
isMainUnitModule :: Module -> Bool
isMainUnitModule :: GenModule Unit -> Bool
isMainUnitModule GenModule Unit
m = GenModule Unit -> Unit
forall unit. GenModule unit -> unit
GHC.moduleUnit GenModule Unit
m Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit
showModule :: Module -> String
showModule :: GenModule Unit -> [Char]
showModule = ModuleName -> [Char]
moduleNameString (ModuleName -> [Char])
-> (GenModule Unit -> ModuleName) -> GenModule Unit -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName
declPath :: [String] -> String
declPath :: [[Char]] -> [Char]
declPath = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"."
showFixity :: TyThing -> Fixity -> SDoc
showFixity :: TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
| Fixity
fixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
/= Fixity
GHC.defaultFixity Bool -> Bool -> Bool
|| OccName -> Bool
isSymOcc (TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyThing
thing)
= Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (TyThing -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyThing
thing)
| Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
expandPath :: MonadIO m => String -> m String
expandPath :: forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath = IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char])
-> ([Char] -> IO [Char]) -> [Char] -> m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO [Char]
expandPathIO
expandPathIO :: String -> IO String
expandPathIO :: [Char] -> IO [Char]
expandPathIO [Char]
p =
case (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
p of
(Char
'~':[Char]
d) -> do
[Char]
tilde <- IO [Char]
getHomeDirectory
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char]
tilde [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
d)
[Char]
other ->
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
other
wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
wantInterpretedModule :: forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (GenModule Unit)
wantInterpretedModule [Char]
str = ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
wantInterpretedModuleName ([Char] -> ModuleName
GHC.mkModuleName [Char]
str)
wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName :: forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
wantInterpretedModuleName ModuleName
modname = do
GenModule Unit
modl <- ModuleName -> m (GenModule Unit)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> m (GenModule Unit)
lookupModuleName ModuleName
modname
let str :: [Char]
str = ModuleName -> [Char]
moduleNameString ModuleName
modname
HomeUnit
home_unit <- HscEnv -> HomeUnit
hsc_home_unit (HscEnv -> HomeUnit) -> m HscEnv -> m HomeUnit
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (HomeUnit -> GenModule Unit -> Bool
isHomeModule HomeUnit
home_unit GenModule Unit
modl) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError ([Char]
"module '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is from another package;\nthis command requires an interpreted module"))
Bool
is_interpreted <- GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.moduleIsInterpreted GenModule Unit
modl
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
is_interpreted) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError ([Char]
"module '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is not interpreted; try \':add *" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' first"))
GenModule Unit -> m (GenModule Unit)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return GenModule Unit
modl
wantNameFromInterpretedModule :: GHC.GhcMonad m
=> (Name -> SDoc -> m ())
-> String
-> (Name -> m ())
-> m ()
wantNameFromInterpretedModule :: forall (m :: Type -> Type).
GhcMonad m =>
(Name -> SDoc -> m ()) -> [Char] -> (Name -> m ()) -> m ()
wantNameFromInterpretedModule Name -> SDoc -> m ()
noCanDo [Char]
str Name -> m ()
and_then =
(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).
(HasLogger m, MonadIO m, HasDynFlags m) =>
SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Name
n NE.:| [Name]
_ <- [Char] -> m (NonEmpty Name)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (NonEmpty Name)
GHC.parseName [Char]
str
let modl :: GenModule Unit
modl = Bool -> GenModule Unit -> GenModule Unit
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName Name
n) (GenModule Unit -> GenModule Unit)
-> GenModule Unit -> GenModule Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> GenModule Unit
Name -> GenModule Unit
GHC.nameModule Name
n
if Bool -> Bool
not (Name -> Bool
GHC.isExternalName Name
n)
then Name -> SDoc -> m ()
noCanDo Name
n (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" is not defined in an interpreted module"
else do
Bool
is_interpreted <- GenModule Unit -> m Bool
forall (m :: Type -> Type). GhcMonad m => GenModule Unit -> m Bool
GHC.moduleIsInterpreted GenModule Unit
modl
if Bool -> Bool
not Bool
is_interpreted
then Name -> SDoc -> m ()
noCanDo Name
n (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"module " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenModule Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule Unit
modl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
[Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
" is not interpreted"
else Name -> m ()
and_then Name
n
clearCaches :: GhciMonad m => m ()
clearCaches :: forall (m :: Type -> Type). GhciMonad m => m ()
clearCaches = m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardActiveBreakPoints
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardInterfaceCache
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
disableUnusedPackages
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearHPTs
splitIdent :: String -> (String, String, String)
splitIdent :: [Char] -> ([Char], [Char], [Char])
splitIdent [] = ([Char]
"", [Char]
"", [Char]
"")
splitIdent inp :: [Char]
inp@(Char
a : [Char]
_)
| (Char -> Bool
isUpper Char
a) = case [Int]
fixs of
[] -> ([Char]
inp, [Char]
"", [Char]
"")
(Int
i1 : [] ) -> (Int -> [Char]
upto Int
i1, Int -> [Char]
from Int
i1, Int -> [Char]
from Int
i1)
(Int
i1 : Int
i2 : [Int]
_) -> (Int -> [Char]
upto Int
i1, Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> [Char]
from Int
i1), Int -> [Char]
from Int
i1)
| Bool
otherwise = case [Int]
ixs of
[] -> ([Char]
"", [Char]
inp, [Char]
inp)
(Int
i1 : [Int]
_) -> ([Char]
"", Int -> [Char]
upto Int
i1, [Char]
inp)
where
ixs :: [Int]
ixs = Char -> [Char] -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices Char
'.' [Char]
inp
fixs :: [Int]
fixs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Int -> Bool
isNextUc [Int]
ixs
isNextUc :: Int -> Bool
isNextUc Int
ix = Char -> Bool
isUpper (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
safeInp [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
safeInp :: [Char]
safeInp = [Char]
inp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
upto :: Int -> [Char]
upto Int
i = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
i [Char]
inp
from :: Int -> [Char]
from Int
i = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
inp
combineModIdent :: String -> String -> String
combineModIdent :: [Char] -> [Char] -> [Char]
combineModIdent [Char]
mod [Char]
ident
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
mod = [Char]
ident
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
ident = [Char]
mod
| Bool
otherwise = [Char]
mod [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ident