{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Clash.GHCi.UI (
interactiveUI,
GhciSettings(..),
defaultGhciSettings,
ghciCommands,
ghciWelcomeMsg,
makeHDL
) where
#include "HsVersions.h"
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 GHC.Runtime.Interpreter.Types
import GHCi.RemoteTypes
import GHCi.BreakArray
import GHC.Driver.Session as DynFlags
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Finder as Finder
import GHC.Driver.Monad ( modifySession )
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
GetDocsFailure(..),
getModuleGraph, handleSourceError, ms_mod )
import GHC.Driver.Main (hscParseDeclsWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
import GHC.Driver.Types ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc,
hsc_dynLinker, hsc_interp, emptyModBreaks )
import GHC.Unit.Module
import GHC.Types.Name
import GHC.Unit.State ( unitIsTrusted, unsafeLookupUnit, unsafeLookupUnitId,
listVisibleModuleNames, pprFlag, preloadUnits )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Core.Ppr.TyThing
import GHC.Builtin.Names
import GHC.Builtin.Types( stringTyCon_RDR )
import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
import GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Parser.Lexer as Lexer
import GHC.Data.StringBuffer
import GHC.Utils.Outputable hiding ( printForUser )
import GHC.Runtime.Loader ( initializePlugins )
import GHC.Types.Basic hiding ( isTopLevel )
import GHC.Data.Graph.Directed
import GHC.Utils.Encoding
import GHC.Data.FastString
import GHC.Runtime.Linker
import GHC.Data.Maybe ( orElse, expectJust )
import GHC.Types.Name.Set
import GHC.Utils.Panic hiding ( showException, try )
import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Bag (unitBag)
import System.Console.Haskeline as Haskeline
import Control.Applicative hiding (empty)
import Control.DeepSeq (deepseq)
import Control.Monad as Monad
import Control.Monad.Catch as MC
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Function
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( elemIndices, find, group, intercalate, intersperse,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import Data.Proxy
import qualified Data.Set as S
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.IntMap.Strict as IntMap
import Data.Time.LocalTime ( getZonedTime )
import Data.Time.Format ( formatTime, defaultTimeLocale )
import Data.Version ( showVersion )
import Prelude hiding ((<>))
import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
import Foreign hiding (void)
import GHC.Stack hiding (SrcLoc(..))
import System.Directory
import System.Environment
import System.Exit ( exitWith, ExitCode(..) )
import System.FilePath
import System.Info
import System.IO
import System.IO.Error
import System.IO.Unsafe ( unsafePerformIO )
import System.Process
import Text.Printf
import Text.Read ( readMaybe )
import Text.Read.Lex (isSymbolChar)
import Unsafe.Coerce
#if !defined(mingw32_HOST_OS)
import System.Posix hiding ( getEnv )
#else
import qualified System.Win32
#endif
import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
import GHC.IO.Handle ( hFlushAll )
import GHC.TopHandler ( topHandler )
import Clash.GHCi.Leak
import Clash.Backend (Backend(initBackend, hdlKind, primDirs))
import Clash.Backend.SystemVerilog (SystemVerilogState)
import Clash.Backend.VHDL (VHDLState)
import Clash.Backend.Verilog (VerilogState)
import qualified Clash.Driver
import Clash.Driver.Types (ClashOpts(..), ClashEnv(..), ClashDesign(..))
import Clash.GHC.Evaluator
import Clash.GHC.GenerateBindings
import Clash.GHC.NetlistTypes
import Clash.GHC.PartialEval
import Clash.GHCi.Common
import Clash.Util (clashLibVersion, reportTimeDiff)
import qualified Data.Time.Clock as Clock
import qualified Paths_clash_ghc
data GhciSettings = GhciSettings {
GhciSettings -> [Command]
availableCommands :: [Command],
GhciSettings -> [Char]
shortHelpText :: String,
GhciSettings -> [Char]
fullHelpText :: String,
GhciSettings -> PromptFunction
defPrompt :: PromptFunction,
GhciSettings -> PromptFunction
defPromptCont :: PromptFunction
}
defaultGhciSettings :: IORef ClashOpts -> GhciSettings
defaultGhciSettings :: IORef ClashOpts -> GhciSettings
defaultGhciSettings IORef ClashOpts
opts =
GhciSettings :: [Command]
-> [Char]
-> [Char]
-> PromptFunction
-> PromptFunction
-> GhciSettings
GhciSettings {
availableCommands :: [Command]
availableCommands = IORef ClashOpts -> [Command]
ghciCommands IORef ClashOpts
opts,
shortHelpText :: [Char]
shortHelpText = [Char]
defShortHelpText,
defPrompt :: PromptFunction
defPrompt = PromptFunction
default_prompt,
defPromptCont :: PromptFunction
defPromptCont = PromptFunction
default_prompt_cont,
fullHelpText :: [Char]
fullHelpText = [Char]
defFullHelpText
}
ghciWelcomeMsg :: String
ghciWelcomeMsg :: [Char]
ghciWelcomeMsg = [Char]
"Clashi, version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
Data.Version.showVersion Version
Paths_clash_ghc.version [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (using clash-lib, version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
Data.Version.showVersion Version
clashLibVersion [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"):\nhttps://clash-lang.org/ :? for help"
ghciCommands :: IORef ClashOpts -> [Command]
ghciCommands :: IORef ClashOpts -> [Command]
ghciCommands IORef ClashOpts
opts = (([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
-> Command)
-> [([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)]
-> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
-> Command
mkCmd [
([Char]
"?", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"add", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
addModule, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"abandon", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
abandonCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"break", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
breakCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeBreakpoint),
([Char]
"back", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
backCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"browse", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
browseCmd Bool
False), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
([Char]
"browse!", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
browseCmd Bool
True), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
([Char]
"cd", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"check", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
checkModule, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModule),
([Char]
"continue", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
continueCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"cmd", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
cmdCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"ctags", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createCTagsWithLineNumbersCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"ctags!", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createCTagsWithRegExesCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"def", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing (Bool -> [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
defineMacro Bool
False), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"def!", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing (Bool -> [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => Bool -> [Char] -> m ()
defineMacro Bool
True), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"delete", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
deleteCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"disable", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
disableCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"doc", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
docCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"edit", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
editFile, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"enable", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
enableCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"etags", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
createETagsFileCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"force", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
forceCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"forward", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
forwardCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"help", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"history", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
historyCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"info", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
False), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"info!", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
True), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"issafe", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
isSafeCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeModule),
([Char]
"kind", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
kindOfType Bool
False), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"kind!", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (Bool -> [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
kindOfType Bool
True), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"load", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModule_, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
([Char]
"load!", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
loadModuleDefer, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
([Char]
"list", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
listCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"module", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
moduleCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetModule),
([Char]
"main", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runMain, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"print", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
printCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"quit", [Char] -> InputT GHCi Bool
forall (m :: Type -> Type). Monad m => [Char] -> m Bool
quit, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"reload", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"reload!", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModuleDefer, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"run", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runRun, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"script", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
scriptCmd, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"set", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetOptions),
([Char]
"seti", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
setiCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSeti),
([Char]
"show", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
showCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowOptions),
([Char]
"showi", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
showiCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeShowiOptions),
([Char]
"sprint", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
sprintCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"step", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"steplocal", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepLocalCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"stepmodule",([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
stepModuleCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeIdentifier),
([Char]
"type", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
typeOfExpr, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"trace", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
traceCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression),
([Char]
"unadd", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
unAddModule, CompletionFunc GHCi
forall (m :: Type -> Type). MonadIO m => CompletionFunc m
completeFilename),
([Char]
"undef", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
undefineMacro, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeMacro),
([Char]
"unset", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
unsetOptions, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeSetOptions),
([Char]
"where", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ()
whereCmd, CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion),
([Char]
"vhdl", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVHDL IORef ClashOpts
opts), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
([Char]
"verilog", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeVerilog IORef ClashOpts
opts), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
([Char]
"systemverilog", ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths (IORef ClashOpts -> [[Char]] -> InputT GHCi ()
makeSystemVerilog IORef ClashOpts
opts), CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeHomeModuleOrFile),
([Char]
"instances", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
instancesCmd, CompletionFunc GHCi
forall (m :: Type -> Type). GhciMonad m => CompletionFunc m
completeExpression)
] [Command] -> [Command] -> [Command]
forall a. [a] -> [a] -> [a]
++ (([Char], [Char] -> InputT GHCi Bool) -> Command)
-> [([Char], [Char] -> InputT GHCi Bool)] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char] -> InputT GHCi Bool) -> Command
mkCmdHidden [
([Char]
"all-types", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
allTypesCmd),
([Char]
"complete", ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
completeCmd),
([Char]
"loc-at", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
locAtCmd),
([Char]
"type-at", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
typeAtCmd),
([Char]
"uses", ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
usesCmd)
]
where
mkCmd :: ([Char], [Char] -> InputT GHCi Bool, CompletionFunc GHCi)
-> Command
mkCmd ([Char]
n,[Char] -> InputT GHCi Bool
a,CompletionFunc GHCi
c) = Command :: [Char]
-> ([Char] -> InputT GHCi Bool)
-> Bool
-> CompletionFunc GHCi
-> Command
Command { cmdName :: [Char]
cmdName = [Char]
n
, cmdAction :: [Char] -> InputT GHCi Bool
cmdAction = [Char] -> InputT GHCi Bool
a
, cmdHidden :: Bool
cmdHidden = Bool
False
, cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
c
}
mkCmdHidden :: ([Char], [Char] -> InputT GHCi Bool) -> Command
mkCmdHidden ([Char]
n,[Char] -> InputT GHCi Bool
a) = Command :: [Char]
-> ([Char] -> InputT GHCi Bool)
-> Bool
-> CompletionFunc GHCi
-> Command
Command { cmdName :: [Char]
cmdName = [Char]
n
, cmdAction :: [Char] -> InputT GHCi Bool
cmdAction = [Char] -> InputT GHCi Bool
a
, cmdHidden :: Bool
cmdHidden = Bool
True
, cmdCompletionFunc :: CompletionFunc GHCi
cmdCompletionFunc = CompletionFunc GHCi
forall (m :: Type -> Type). Monad m => CompletionFunc m
noCompletion
}
word_break_chars :: String
word_break_chars :: [Char]
word_break_chars = [Char]
spaces [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
specials [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
symbols
symbols, specials, spaces :: String
symbols :: [Char]
symbols = [Char]
"!#$%&*+/<=>?@\\^|-~"
specials :: [Char]
specials = [Char]
"(),;[]`{}"
spaces :: [Char]
spaces = [Char]
" \t\n"
flagWordBreakChars :: String
flagWordBreakChars :: [Char]
flagWordBreakChars = [Char]
" \t\n"
keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
keepGoing :: ([Char] -> GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoing [Char] -> GHCi ()
a [Char]
str = ([Char] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' (GHCi () -> InputT GHCi ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi () -> InputT GHCi ())
-> ([Char] -> GHCi ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GHCi ()
a) [Char]
str
keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
keepGoing' :: forall (m :: Type -> Type).
Monad m =>
([Char] -> m ()) -> [Char] -> m Bool
keepGoing' [Char] -> m ()
a [Char]
str = [Char] -> m ()
a [Char]
str m () -> m Bool -> m Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
keepGoingPaths :: ([[Char]] -> InputT GHCi ()) -> [Char] -> InputT GHCi Bool
keepGoingPaths [[Char]] -> InputT GHCi ()
a [Char]
str
= do case [Char] -> Either [Char] [[Char]]
toArgs [Char]
str of
Left [Char]
err -> IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
Right [[Char]]
args -> [[Char]] -> InputT GHCi ()
a [[Char]]
args
Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
defShortHelpText :: String
defShortHelpText :: [Char]
defShortHelpText = [Char]
"use :? for help.\n"
defFullHelpText :: String
defFullHelpText :: [Char]
defFullHelpText =
[Char]
" Commands available from the prompt:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" <statement> evaluate/run <statement>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" : repeat last command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :{\\n ..lines.. \\n:}\\n multiline command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :add [*]<module> ... add module(s) to the current target set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :browse[!] [[*]<mod>] display the names defined by module <mod>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: more details; *: all top-level names)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :cd <dir> change directory to <dir>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :cmd <expr> run the commands returned by <expr>::IO String\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :complete <dom> [<rng>] <s> list completions for partial input string\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :ctags[!] [<file>] create tags file <file> for Vi (default: \"tags\")\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: use regex instead of line number)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :def[!] <cmd> <expr> define command :<cmd> (later defined command has\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" precedence, ::<cmd> is always a builtin command)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: redefine an existing command name)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :doc <name> display docs for the given name (experimental)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :edit <file> edit file\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :edit edit last module\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :etags [<file>] create tags file <file> for Emacs (default: \"TAGS\")\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :help, :? display this list of commands\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :info[!] [<name> ...] display information about the given names\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: do not filter instances)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :instances <type> display the class instances available for <type>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :issafe [<mod>] display safe haskell information of module <mod>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :kind[!] <type> show the kind of <type>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: also print the normalised type)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :load[!] [*]<module> ... load module(s) and their dependents\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: defer type errors)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :main [<arguments> ...] run the main function with the given arguments\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :module [+/-] [*]<mod> ... set the context for expression evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :quit exit GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :reload[!] reload the current module set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (!: defer type errors)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :run function [<arguments> ...] run the function with the given arguments\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :script <file> run the script <file>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :type <expr> show the type of <expr>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :type +d <expr> show the type of <expr>, defaulting type variables\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :type +v <expr> show the type of <expr>, with its specified tyvars\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :unadd <module> ... remove module(s) from the current target set\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :undef <cmd> undefine user-defined command :<cmd>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" ::<cmd> run the builtin command\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :!<command> run the shell command <command>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :vhdl synthesize currently loaded module to vhdl\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :vhdl [<module>] synthesize specified modules/files to vhdl\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :verilog synthesize currently loaded module to verilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :verilog [<module>] synthesize specified modules/files to verilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :systemverilog synthesize currently loaded module to systemverilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :systemverilog [<module>] synthesize specified modules/files to systemverilog\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" -- Commands for debugging:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :abandon at a breakpoint, abandon current computation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :back [<n>] go back in the history N steps (after :trace)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :break [<mod>] <l> [<col>] set a breakpoint at the specified location\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :break <name> set a breakpoint on the specified function\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :continue resume after a breakpoint\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :delete <number> ... delete the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :delete * delete all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :disable <number> ... disable the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :disable * disable all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :enable <number> ... enable the specified breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :enable * enable all breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :force <expr> print <expr>, forcing unevaluated parts\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :forward [<n>] go forward in the history N step s(after :back)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :history [<n>] after :trace, show the execution history\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :list show the source code around current breakpoint\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :list <identifier> show the source code for <identifier>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :list [<module>] <line> show the source code around line number <line>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :print [<name> ...] show a value without forcing its computation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :sprint [<name> ...] simplified version of :print\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :step single-step after stopping at a breakpoint\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :step <expr> single-step into <expr>\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :steplocal single-step within the current top-level binding\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :stepmodule single-step restricted to the current module\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :trace trace after stopping at a breakpoint\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :trace <expr> evaluate <expr> with tracing on (see :history)\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" -- Commands for changing settings:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set <option> ... set options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :seti <option> ... set options for interactive evaluation only\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set local-config { source | ignore }\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" set whether to source .ghci in current dir\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (loading untrusted config is a security issue)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set args <arg> ... set the arguments returned by System.getArgs\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prog <progname> set the value returned by System.getProgName\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prompt <prompt> set the prompt used in GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prompt-cont <prompt> set the continuation prompt used in GHCi\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prompt-function <expr> set the function to handle the prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set prompt-cont-function <expr>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" set the function to handle the continuation prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set editor <cmd> set the command used for :edit\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :set stop [<n>] <cmd> set the command to run when a breakpoint is hit\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :unset <option> ... unset options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" Options for ':set' and ':unset':\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" +m allow multiline commands\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" +r revert top-level expressions after each evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" +s print timing/memory stats after each evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" +t print type after evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" +c collect type/location info after loading modules\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" -<flags> most GHC command line flags can also be set here\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" (eg. -v2, -XFlexibleInstances, etc.)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" for GHCi-specific flags, see User's Guide,\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" Flag reference, Interactive-mode options\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" -- Commands for displaying information:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show bindings show the current bindings made at the prompt\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show breaks show the active breakpoints\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show context show the breakpoint context\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show imports show the current imports\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show linker show current linker state\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show modules show the currently loaded modules\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show packages show the currently active package flags\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show paths show the currently active search paths\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show language show the currently active language flags\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show targets show the current set of targets\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :show <setting> show value of <setting>, which is one of\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" [args, prog, editor, stop]\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" :showi language show language flags for interactive evaluation\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" The User's Guide has more information. An online copy can be found here:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\n"
findEditor :: IO String
findEditor :: IO [Char]
findEditor = do
[Char] -> IO [Char]
getEnv [Char]
"EDITOR"
IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
#if defined(mingw32_HOST_OS)
win <- System.Win32.getWindowsDirectory
return (win </> "notepad.exe")
#else
[Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
#endif
default_progname, default_stop :: String
default_progname :: [Char]
default_progname = [Char]
"<interactive>"
default_stop :: [Char]
default_stop = [Char]
""
default_prompt, default_prompt_cont :: PromptFunction
default_prompt :: PromptFunction
default_prompt = [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
"clashi> "
default_prompt_cont :: PromptFunction
default_prompt_cont = [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
"| "
default_args :: [String]
default_args :: [[Char]]
default_args = []
interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
-> Ghc ()
interactiveUI :: GhciSettings -> [([Char], Maybe Phase)] -> Maybe [[Char]] -> Ghc ()
interactiveUI GhciSettings
config [([Char], Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs = do
StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stdin
StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stdout
StablePtr Handle
_ <- IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (StablePtr Handle) -> Ghc (StablePtr Handle))
-> IO (StablePtr Handle) -> Ghc (StablePtr Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (StablePtr Handle)
forall a. a -> IO (StablePtr a)
newStablePtr Handle
stderr
(ForeignHValue
nobuffering, ForeignHValue
flush) <- 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'
IORef [(FastString, Int)]
lastErrLocationsRef <- IO (IORef [(FastString, Int)]) -> Ghc (IORef [(FastString, Int)])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef [(FastString, Int)]) -> Ghc (IORef [(FastString, Int)]))
-> IO (IORef [(FastString, Int)])
-> Ghc (IORef [(FastString, Int)])
forall a b. (a -> b) -> a -> b
$ [(FastString, Int)] -> IO (IORef [(FastString, Int)])
forall a. a -> IO (IORef a)
newIORef []
DynFlags
progDynFlags <- Ghc DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getProgramDynFlags
Bool
_ <- DynFlags -> Ghc Bool
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m Bool
GHC.setProgramDynFlags (DynFlags -> Ghc Bool) -> DynFlags -> Ghc Bool
forall a b. (a -> b) -> a -> b
$
DynFlags
progDynFlags { log_action :: LogAction
log_action = LogAction -> IORef [(FastString, Int)] -> LogAction
ghciLogAction (DynFlags -> LogAction
log_action DynFlags
progDynFlags)
IORef [(FastString, Int)]
lastErrLocationsRef }
Bool -> Ghc () -> Ghc ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [[Char]]
maybe_exprs) (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ do
ForeignHValue -> Ghc ()
forall (m :: Type -> Type). GhcMonad m => ForeignHValue -> m ()
turnOffBuffering_ ForeignHValue
nobuffering
IO () -> Ghc ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
IO () -> Ghc ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
IO () -> Ghc ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
IO () -> Ghc ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
#if defined(mingw32_HOST_OS)
liftIO $ hSetEncoding stdin utf8
#endif
[Char]
default_editor <- IO [Char] -> Ghc [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> Ghc [Char]) -> IO [Char] -> Ghc [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
findEditor
ForeignHValue
eval_wrapper <- [Char] -> [[Char]] -> Ghc ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> [[Char]] -> m ForeignHValue
mkEvalWrapper [Char]
default_progname [[Char]]
default_args
let prelude_import :: ImportDecl (GhcPass p)
prelude_import = ModuleName -> ImportDecl (GhcPass p)
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl ModuleName
preludeModuleName
GHCi () -> GHCiState -> Ghc ()
forall a. GHCi a -> GHCiState -> Ghc a
startGHCi ([([Char], Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe Phase)]
srcs Maybe [[Char]]
maybe_exprs)
GHCiState :: [Char]
-> [[Char]]
-> ForeignHValue
-> PromptFunction
-> PromptFunction
-> [Char]
-> [Char]
-> LocalConfigBehaviour
-> [GHCiOption]
-> Int
-> Int
-> IntMap BreakLocation
-> ModuleEnv TickArray
-> [Command]
-> [Command]
-> Maybe Command
-> (InputT GHCi CommandResult -> InputT GHCi (Maybe Bool))
-> [[Char]]
-> [InteractiveImport]
-> [InteractiveImport]
-> [ImportDecl GhcPs]
-> [ImportDecl GhcPs]
-> Bool
-> [Char]
-> [Char]
-> IORef [(FastString, Int)]
-> Map ModuleName ModInfo
-> ForeignHValue
-> ForeignHValue
-> GHCiState
GHCiState{ progname :: [Char]
progname = [Char]
default_progname,
args :: [[Char]]
args = [[Char]]
default_args,
evalWrapper :: ForeignHValue
evalWrapper = ForeignHValue
eval_wrapper,
prompt :: PromptFunction
prompt = GhciSettings -> PromptFunction
defPrompt GhciSettings
config,
prompt_cont :: PromptFunction
prompt_cont = GhciSettings -> PromptFunction
defPromptCont GhciSettings
config,
stop :: [Char]
stop = [Char]
default_stop,
editor :: [Char]
editor = [Char]
default_editor,
options :: [GHCiOption]
options = [],
localConfig :: LocalConfigBehaviour
localConfig = LocalConfigBehaviour
SourceLocalConfig,
line_number :: Int
line_number = Int
0,
break_ctr :: Int
break_ctr = Int
0,
breaks :: IntMap BreakLocation
breaks = IntMap BreakLocation
forall a. IntMap a
IntMap.empty,
tickarrays :: ModuleEnv TickArray
tickarrays = ModuleEnv TickArray
forall a. ModuleEnv a
emptyModuleEnv,
ghci_commands :: [Command]
ghci_commands = GhciSettings -> [Command]
availableCommands GhciSettings
config,
ghci_macros :: [Command]
ghci_macros = [],
last_command :: Maybe Command
last_command = Maybe Command
forall a. Maybe a
Nothing,
cmd_wrapper :: InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
cmd_wrapper = (CommandResult -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type).
MonadThrow m =>
CommandResult -> m (Maybe Bool)
cmdSuccess (CommandResult -> InputT GHCi (Maybe Bool))
-> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<),
cmdqueue :: [[Char]]
cmdqueue = [],
remembered_ctx :: [InteractiveImport]
remembered_ctx = [],
transient_ctx :: [InteractiveImport]
transient_ctx = [],
extra_imports :: [ImportDecl GhcPs]
extra_imports = [],
prelude_imports :: [ImportDecl GhcPs]
prelude_imports = [ImportDecl GhcPs
forall {p :: Pass}. ImportDecl (GhcPass p)
prelude_import],
ghc_e :: Bool
ghc_e = Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs,
short_help :: [Char]
short_help = GhciSettings -> [Char]
shortHelpText GhciSettings
config,
long_help :: [Char]
long_help = GhciSettings -> [Char]
fullHelpText GhciSettings
config,
lastErrorLocations :: IORef [(FastString, Int)]
lastErrorLocations = IORef [(FastString, Int)]
lastErrLocationsRef,
mod_infos :: Map ModuleName ModInfo
mod_infos = Map ModuleName ModInfo
forall k a. Map k a
M.empty,
flushStdHandles :: ForeignHValue
flushStdHandles = ForeignHValue
flush,
noBuffering :: ForeignHValue
noBuffering = ForeignHValue
nobuffering
}
() -> Ghc ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
resetLastErrorLocations :: GhciMonad m => m ()
resetLastErrorLocations :: forall (m :: Type -> Type). GhciMonad m => m ()
resetLastErrorLocations = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [(FastString, Int)] -> [(FastString, Int)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (GHCiState -> IORef [(FastString, Int)]
lastErrorLocations GHCiState
st) []
ghciLogAction :: LogAction -> IORef [(FastString, Int)] -> LogAction
ghciLogAction :: LogAction -> IORef [(FastString, Int)] -> LogAction
ghciLogAction LogAction
old_log_action IORef [(FastString, Int)]
lastErrLocations
DynFlags
dflags WarnReason
flag Severity
severity SrcSpan
srcSpan SDoc
msg = do
LogAction
old_log_action DynFlags
dflags WarnReason
flag Severity
severity SrcSpan
srcSpan SDoc
msg
case Severity
severity of
Severity
SevError -> case SrcSpan
srcSpan of
RealSrcSpan RealSrcSpan
rsp Maybe BufSpan
_ -> IORef [(FastString, Int)]
-> ([(FastString, Int)] -> [(FastString, Int)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(FastString, Int)]
lastErrLocations
([(FastString, Int)] -> [(FastString, Int)] -> [(FastString, Int)]
forall a. [a] -> [a] -> [a]
++ [(RealSrcLoc -> FastString
srcLocFile (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
rsp), RealSrcLoc -> Int
srcLocLine (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
rsp))])
SrcSpan
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Severity
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
withGhcAppData :: forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData [Char] -> IO a
right IO a
left = do
Either IOException [Char]
either_dir <- IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IO [Char]
getAppUserDataDirectory [Char]
"clash")
case Either IOException [Char]
either_dir of
Right [Char]
dir ->
do Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
dir IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
[Char] -> IO a
right [Char]
dir
Either IOException [Char]
_ -> IO a
left
runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
runGHCi :: [([Char], Maybe Phase)] -> Maybe [[Char]] -> GHCi ()
runGHCi [([Char], Maybe Phase)]
paths Maybe [[Char]]
maybe_exprs = do
DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let
ignore_dot_ghci :: Bool
ignore_dot_ghci = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_IgnoreDotGhci DynFlags
dflags
app_user_dir :: GHCi (Maybe [Char])
app_user_dir = IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData
(\[Char]
dir -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"clashi.conf")))
(Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
home_dir :: GHCi (Maybe [Char])
home_dir = do
Either IOException [Char]
either_dir <- IO (Either IOException [Char]) -> GHCi (Either IOException [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char])
-> GHCi (Either IOException [Char]))
-> IO (Either IOException [Char])
-> GHCi (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IO [Char]
getEnv [Char]
"HOME")
case Either IOException [Char]
either_dir of
Right [Char]
home -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
home [Char] -> [Char] -> [Char]
</> [Char]
".clashi"))
Either IOException [Char]
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
canonicalizePath' :: FilePath -> IO (Maybe FilePath)
canonicalizePath' :: [Char] -> IO (Maybe [Char])
canonicalizePath' [Char]
fp = ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> IO [Char]
canonicalizePath [Char]
fp)
IO (Maybe [Char])
-> (IOException -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
sourceConfigFile :: FilePath -> GHCi ()
sourceConfigFile :: [Char] -> GHCi ()
sourceConfigFile [Char]
file = do
Bool
exists <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> GHCi Bool) -> IO Bool -> GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
file
Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
exists (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
Either IOException Handle
either_hdl <- IO (Either IOException Handle) -> GHCi (Either IOException Handle)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Handle)
-> GHCi (Either IOException Handle))
-> IO (Either IOException Handle)
-> GHCi (Either IOException Handle)
forall a b. (a -> b) -> a -> b
$ IO Handle -> IO (Either IOException Handle)
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IOMode -> IO Handle
openFile [Char]
file IOMode
ReadMode)
case Either IOException Handle
either_hdl of
Left IOException
_e -> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Right Handle
hdl ->
do Prefs -> Settings GHCi -> InputT GHCi () -> GHCi ()
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi () -> GHCi ()) -> InputT GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands (InputT GHCi (Maybe [Char]) -> InputT GHCi ())
-> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
hdl
IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
hdl IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [[Char]]
maybe_exprs Bool -> Bool -> Bool
&& DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char]
"Loaded Clashi configuration from " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file)
GHCi ()
forall (m :: Type -> Type). GhciMonad m => m ()
setGHCContextFromGHCiState
[[Char]]
processedCfgs <- if Bool
ignore_dot_ghci
then [[Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
else do
[[Char]]
userCfgs <- do
[[Char]]
paths <- [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]])
-> GHCi [Maybe [Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [GHCi (Maybe [Char])] -> GHCi [Maybe [Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ GHCi (Maybe [Char])
app_user_dir, GHCi (Maybe [Char])
home_dir ]
[[Char]]
checkedPaths <- IO [[Char]] -> GHCi [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> GHCi [[Char]]) -> IO [[Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
checkFileAndDirPerms [[Char]]
paths
IO [[Char]] -> GHCi [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> GHCi [[Char]])
-> (IO [Maybe [Char]] -> IO [[Char]])
-> IO [Maybe [Char]]
-> GHCi [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([Maybe [Char]] -> [[Char]]) -> [Maybe [Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes) (IO [Maybe [Char]] -> GHCi [[Char]])
-> IO [Maybe [Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO (Maybe [Char])
canonicalizePath' [[Char]]
checkedPaths
Maybe [Char]
localCfg <- do
let path :: [Char]
path = [Char]
".clashi"
Bool
ok <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> GHCi Bool) -> IO Bool -> GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
checkFileAndDirPerms [Char]
path
if Bool
ok then IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
canonicalizePath' [Char]
path else Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
([Char] -> GHCi ()) -> [[Char]] -> GHCi ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> GHCi ()
sourceConfigFile [[Char]]
userCfgs
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 (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ [Char] -> GHCi ()
sourceConfigFile [Char]
path
LocalConfigBehaviour
IgnoreLocalConfig -> Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
Maybe [Char]
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
[[Char]] -> GHCi [[Char]]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> GHCi [[Char]]) -> [[Char]] -> GHCi [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]] -> [[Char]])
-> Maybe [Char]
-> [[Char]]
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[Char]] -> [[Char]]
forall a. a -> a
id (:) Maybe [Char]
processedLocalCfg [[Char]]
userCfgs
let arg_cfgs :: [[Char]]
arg_cfgs = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ DynFlags -> [[Char]]
ghciScripts DynFlags
dflags
([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 Phase)] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [([Char], Maybe Phase)]
paths)) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ do
SuccessFlag
ok <- (SomeException -> GHCi SuccessFlag)
-> GHCi SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
e -> do SomeException -> GHCi ()
forall (m :: Type -> Type). MonadIO m => SomeException -> m ()
showException SomeException
e; SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Failed) (GHCi SuccessFlag -> GHCi SuccessFlag)
-> GHCi SuccessFlag -> GHCi SuccessFlag
forall a b. (a -> b) -> a -> b
$
Prefs
-> Settings GHCi -> InputT GHCi SuccessFlag -> GHCi SuccessFlag
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Prefs -> Settings m -> InputT m a -> m a
runInputTWithPrefs Prefs
defaultPrefs Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings (InputT GHCi SuccessFlag -> GHCi SuccessFlag)
-> InputT GHCi SuccessFlag -> GHCi SuccessFlag
forall a b. (a -> b) -> a -> b
$
[([Char], Maybe Phase)] -> InputT GHCi SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule [([Char], Maybe Phase)]
paths
Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs Bool -> Bool -> Bool
&& SuccessFlag -> Bool
failed SuccessFlag
ok) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1))
Maybe [Char] -> Bool -> GHCi ()
forall (m :: Type -> Type).
GhcMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint (DynFlags -> Maybe [Char]
interactivePrint DynFlags
dflags) (Maybe [[Char]] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [[Char]]
maybe_exprs)
Bool
is_tty <- IO Bool -> GHCi Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO Bool
hIsTerminalDevice Handle
stdin)
let show_prompt :: Bool
show_prompt = DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Bool
is_tty
(GHCiState -> GHCiState) -> GHCi ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState ((GHCiState -> GHCiState) -> GHCi ())
-> (GHCiState -> GHCiState) -> GHCi ()
forall a b. (a -> b) -> a -> b
$ \GHCiState
st -> GHCiState
st{line_number :: Int
line_number=Int
0}
case Maybe [[Char]]
maybe_exprs of
Maybe [[Char]]
Nothing ->
do
[[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 ()
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 (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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
(Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
() -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Leaving GHCi."
runGHCiExpressions :: [String] -> GHCi ()
runGHCiExpressions :: [[Char]] -> GHCi ()
runGHCiExpressions [[Char]]
exprs = do
[[Char]] -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]]
exprs
let hdle :: SomeException -> m b
hdle SomeException
e = do GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
IO b -> m b
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ [Char] -> IO b -> IO b
forall a. [Char] -> IO a -> IO a
withProgName (GHCiState -> [Char]
progname GHCiState
st)
(IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ SomeException -> IO b
forall a. SomeException -> IO a
topHandler SomeException
e
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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ())
(Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
() -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
runGHCiInput :: InputT GHCi a -> GHCi a
runGHCiInput :: forall a. InputT GHCi a -> GHCi a
runGHCiInput InputT GHCi a
f = do
DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let ghciHistory :: Bool
ghciHistory = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciHistory DynFlags
dflags
let localGhciHistory :: Bool
localGhciHistory = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LocalGhciHistory DynFlags
dflags
[Char]
currentDirectory <- IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getCurrentDirectory
Maybe [Char]
histFile <- case (Bool
ghciHistory, Bool
localGhciHistory) of
(Bool
True, Bool
True) -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
currentDirectory [Char] -> [Char] -> [Char]
</> [Char]
".ghci_history"))
(Bool
True, Bool
_) -> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> GHCi (Maybe [Char]))
-> IO (Maybe [Char]) -> GHCi (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a. ([Char] -> IO a) -> IO a -> IO a
withGhcAppData
(\[Char]
dir -> Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"ghci_history"))) (Maybe [Char] -> IO (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
(Bool, Bool)
_ -> Maybe [Char] -> GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
Settings GHCi -> InputT GHCi a -> GHCi a
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT
(CompletionFunc GHCi -> Settings GHCi -> Settings GHCi
forall (m :: Type -> Type).
CompletionFunc m -> Settings m -> Settings m
setComplete CompletionFunc GHCi
ghciCompleteWord (Settings GHCi -> Settings GHCi) -> Settings GHCi -> Settings GHCi
forall a b. (a -> b) -> a -> b
$ Settings GHCi
forall (m :: Type -> Type). MonadIO m => Settings m
defaultSettings {historyFile :: Maybe [Char]
historyFile = Maybe [Char]
histFile})
InputT GHCi a
f
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe [Char])
nextInputLine Bool
show_prompt Bool
is_tty
| Bool
is_tty = do
[Char]
prmpt <- if Bool
show_prompt then GHCi [Char] -> InputT GHCi [Char]
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt else [Char] -> InputT GHCi [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
Maybe [Char]
r <- [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
(MonadIO m, MonadMask m) =>
[Char] -> InputT m (Maybe [Char])
getInputLine [Char]
prmpt
InputT GHCi ()
forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo
Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
r
| Bool
otherwise = do
Bool -> InputT GHCi () -> InputT GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
show_prompt (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ GHCi [Char] -> InputT GHCi [Char]
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi [Char]
mkPrompt InputT GHCi [Char] -> ([Char] -> InputT GHCi ()) -> InputT GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ())
-> ([Char] -> IO ()) -> [Char] -> InputT GHCi ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStr
Handle -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
stdin
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 (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
where
getDirectory :: [Char] -> [Char]
getDirectory [Char]
f = case [Char] -> [Char]
takeDirectory [Char]
f of
[Char]
"" -> [Char]
"."
[Char]
d -> [Char]
d
checkPerms :: FilePath -> IO Bool
#if defined(mingw32_HOST_OS)
checkPerms _ = return True
#else
checkPerms :: [Char] -> IO Bool
checkPerms [Char]
file =
(IOException -> IO Bool) -> IO Bool -> IO Bool
forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (\IOException
_ -> Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
FileStatus
st <- [Char] -> IO FileStatus
getFileStatus [Char]
file
UserID
me <- IO UserID
getRealUserID
let mode :: FileMode
mode = FileStatus -> FileMode
System.Posix.fileMode FileStatus
st
ok :: Bool
ok = (FileStatus -> UserID
fileOwner FileStatus
st UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
me Bool -> Bool -> Bool
|| FileStatus -> UserID
fileOwner FileStatus
st UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
0) Bool -> Bool -> Bool
&&
FileMode
groupWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
mode FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
groupWriteMode Bool -> Bool -> Bool
&&
FileMode
otherWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
mode FileMode -> FileMode -> FileMode
`intersectFileModes` FileMode
otherWriteMode
Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"*** WARNING: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" is writable by someone else, IGNORING!" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"\nSuggested fix: execute 'chmod go-w " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
ok
#endif
incrementLineNo :: GhciMonad m => m ()
incrementLineNo :: forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState GHCiState -> GHCiState
incLineNo
where
incLineNo :: GHCiState -> GHCiState
incLineNo GHCiState
st = GHCiState
st { line_number :: Int
line_number = GHCiState -> Int
line_number GHCiState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
fileLoop :: GhciMonad m => Handle -> m (Maybe String)
fileLoop :: forall (m :: Type -> Type).
GhciMonad m =>
Handle -> m (Maybe [Char])
fileLoop Handle
hdl = do
Either IOException [Char]
l <- IO (Either IOException [Char]) -> m (Either IOException [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char]) -> m (Either IOException [Char]))
-> IO (Either IOException [Char]) -> m (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO (IO [Char] -> IO (Either IOException [Char]))
-> IO [Char] -> IO (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ Handle -> IO [Char]
hGetLine Handle
hdl
case Either IOException [Char]
l of
Left IOException
e | IOException -> Bool
isEOFError IOException
e -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
|
IOException -> Bool
isIllegalOperation IOException
e -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
| IOErrorType
InvalidArgument <- IOErrorType
etype -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
| Bool
otherwise -> IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ IOException -> IO (Maybe [Char])
forall a. IOException -> IO a
ioError IOException
e
where etype :: IOErrorType
etype = IOException -> IOErrorType
ioeGetErrorType IOException
e
Right [Char]
l' -> do
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
incrementLineNo
Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
l')
formatCurrentTime :: String -> IO String
formatCurrentTime :: [Char] -> IO [Char]
formatCurrentTime [Char]
format =
IO ZonedTime
getZonedTime IO ZonedTime -> (ZonedTime -> IO [Char]) -> IO [Char]
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> IO [Char])
-> (ZonedTime -> [Char]) -> ZonedTime -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocale -> [Char] -> ZonedTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
format)
getUserName :: IO String
getUserName :: IO [Char]
getUserName = do
#if defined(mingw32_HOST_OS)
getEnv "USERNAME"
`catchIO` \e -> do
putStrLn $ show e
return ""
#else
IO [Char]
getLoginName
#endif
getInfoForPrompt :: GhciMonad m => m (SDoc, [String], Int)
getInfoForPrompt :: forall (m :: Type -> Type). GhciMonad m => m (SDoc, [[Char]], Int)
getInfoForPrompt = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
[InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
SDoc
context_bit <-
case [Resume]
resumes of
[] -> SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
empty
Resume
r:[Resume]
_ -> do
let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
brackets (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Resume -> SrcSpan
GHC.resumeSpan Resume
r)) SDoc -> SDoc -> SDoc
<> SDoc
space)
else do
let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
SrcSpan
pan <- History -> m SrcSpan
forall (m :: Type -> Type). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan History
hist
SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> SDoc
brackets (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> Int
forall a. Num a => a -> a
negate Int
ix) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan) SDoc -> SDoc -> SDoc
<> SDoc
space)
let
dots :: SDoc
dots | Resume
_:[Resume]
rs <- [Resume]
resumes, Bool -> Bool
not ([Resume] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Resume]
rs) = [Char] -> SDoc
text [Char]
"... "
| Bool
otherwise = SDoc
empty
rev_imports :: [InteractiveImport]
rev_imports = [InteractiveImport] -> [InteractiveImport]
forall a. [a] -> [a]
reverse [InteractiveImport]
imports
myIdeclName :: ImportDecl pass -> ModuleName
myIdeclName ImportDecl pass
d | Just Located ModuleName
m <- ImportDecl pass -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl pass
d = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc Located ModuleName
m
| Bool
otherwise = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl pass -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl pass
d)
modules_names :: [[Char]]
modules_names =
[Char
'*'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:(ModuleName -> [Char]
moduleNameString ModuleName
m) | IIModule ModuleName
m <- [InteractiveImport]
rev_imports] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[ModuleName -> [Char]
moduleNameString (ImportDecl GhcPs -> ModuleName
forall {pass}. ImportDecl pass -> ModuleName
myIdeclName ImportDecl GhcPs
d) | IIDecl ImportDecl GhcPs
d <- [InteractiveImport]
rev_imports]
line :: Int
line = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GHCiState -> Int
line_number GHCiState
st
(SDoc, [[Char]], Int) -> m (SDoc, [[Char]], Int)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc
dots SDoc -> SDoc -> SDoc
<> SDoc
context_bit, [[Char]]
modules_names, Int
line)
parseCallEscape :: String -> (String, String)
parseCallEscape :: [Char] -> ([Char], [Char])
parseCallEscape [Char]
s
| Bool -> Bool
not ((Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
beforeOpen) = ([Char]
"", [Char]
"")
| [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
sinceOpen = ([Char]
"", [Char]
"")
| [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
sinceClosed = ([Char]
"", [Char]
"")
| [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
cmd = ([Char]
"", [Char]
"")
| Bool
otherwise = ([Char]
cmd, [Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
sinceClosed)
where
([Char]
beforeOpen, [Char]
sinceOpen) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'(') [Char]
s
([Char]
cmd, [Char]
sinceClosed) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') ([Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
sinceOpen)
checkPromptStringForErrors :: String -> Maybe String
checkPromptStringForErrors :: [Char] -> Maybe [Char]
checkPromptStringForErrors (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) =
case [Char] -> ([Char], [Char])
parseCallEscape [Char]
xs of
([Char]
"", [Char]
"") -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"Incorrect %call syntax. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"Should be %call(a command and arguments).")
([Char]
_, [Char]
afterClosed) -> [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
afterClosed
checkPromptStringForErrors (Char
'%':Char
'%':[Char]
xs) = [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
xs
checkPromptStringForErrors (Char
_:[Char]
xs) = [Char] -> Maybe [Char]
checkPromptStringForErrors [Char]
xs
checkPromptStringForErrors [Char]
"" = Maybe [Char]
forall a. Maybe a
Nothing
generatePromptFunctionFromString :: String -> PromptFunction
generatePromptFunctionFromString :: [Char] -> PromptFunction
generatePromptFunctionFromString [Char]
promptS [[Char]]
modules_names Int
line =
[Char] -> GHCi SDoc
processString [Char]
promptS
where
processString :: String -> GHCi SDoc
processString :: [Char] -> GHCi SDoc
processString (Char
'%':Char
's':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
modules_list) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
modules_list :: SDoc
modules_list = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
text [[Char]]
modules_names
processString (Char
'%':Char
'l':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> GHCi SDoc) -> SDoc -> GHCi SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
line) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'd':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%a %b %d"
processString (Char
'%':Char
't':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%H:%M:%S"
processString (Char
'%':Char
'T':[Char]
xs) = do
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%I:%M:%S"
processString (Char
'%':Char
'@':[Char]
xs) = do
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%I:%M %P"
processString (Char
'%':Char
'A':[Char]
xs) = do
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
formatted_time) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
formatted_time :: GHCi [Char]
formatted_time = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
formatCurrentTime [Char]
"%H:%M"
processString (Char
'%':Char
'u':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
user_name) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
user_name :: GHCi [Char]
user_name = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getUserName
processString (Char
'%':Char
'w':[Char]
xs) =
(SDoc -> SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SDoc -> SDoc -> SDoc
(<>) (([Char] -> SDoc) -> GHCi [Char] -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM [Char] -> SDoc
text GHCi [Char]
current_directory) ([Char] -> GHCi SDoc
processString [Char]
xs)
where
current_directory :: GHCi [Char]
current_directory = IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getCurrentDirectory
processString (Char
'%':Char
'o':[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
os) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'a':[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
arch) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'N':[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
compilerName) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'V':[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text ([Char] -> SDoc) -> [Char] -> SDoc
forall a b. (a -> b) -> a -> b
$ Version -> [Char]
showVersion Version
compilerVersion) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
'%':Char
'c':Char
'a':Char
'l':Char
'l':[Char]
xs) = do
[Char]
respond <- IO [Char] -> GHCi [Char]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> GHCi [Char]) -> IO [Char] -> GHCi [Char]
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
code, [Char]
out, [Char]
err) <-
[Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode
([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
list_words) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
list_words) [Char]
""
IO (ExitCode, [Char], [Char])
-> (IOException -> IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
e -> (ExitCode, [Char], [Char]) -> IO (ExitCode, [Char], [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, [Char]
"", IOException -> [Char]
forall a. Show a => a -> [Char]
show IOException
e)
case ExitCode
code of
ExitCode
ExitSuccess -> [Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
out
ExitCode
_ -> do
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
[Char] -> IO [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return [Char]
""
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (([Char] -> SDoc
text [Char]
respond) SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
afterClosed)
where
([Char]
cmd, [Char]
afterClosed) = [Char] -> ([Char], [Char])
parseCallEscape [Char]
xs
list_words :: [[Char]]
list_words = [Char] -> [[Char]]
words [Char]
cmd
processString (Char
'%':Char
'%':[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM ((Char -> SDoc
char Char
'%') SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString (Char
x:[Char]
xs) =
(SDoc -> SDoc) -> GHCi SDoc -> GHCi SDoc
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
liftM (Char -> SDoc
char Char
x SDoc -> SDoc -> SDoc
<>) ([Char] -> GHCi SDoc
processString [Char]
xs)
processString [Char]
"" =
SDoc -> GHCi SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return SDoc
empty
mkPrompt :: GHCi String
mkPrompt :: GHCi [Char]
mkPrompt = do
GHCiState
st <- GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
(SDoc
context, [[Char]]
modules_names, Int
line) <- GHCi (SDoc, [[Char]], Int)
forall (m :: Type -> Type). GhciMonad m => m (SDoc, [[Char]], Int)
getInfoForPrompt
SDoc
prompt_string <- (GHCiState -> PromptFunction
prompt GHCiState
st) [[Char]]
modules_names Int
line
let prompt_doc :: SDoc
prompt_doc = SDoc
context SDoc -> SDoc -> SDoc
<> SDoc
prompt_string
[Char] -> GHCi [Char]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dflags SDoc
prompt_doc)
queryQueue :: GhciMonad m => m (Maybe String)
queryQueue :: forall (m :: Type -> Type). GhciMonad m => m (Maybe [Char])
queryQueue = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
case GHCiState -> [[Char]]
cmdqueue GHCiState
st of
[] -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
[Char]
c:[[Char]]
cs -> do GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ cmdqueue :: [[Char]]
cmdqueue = [[Char]]
cs }
Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c)
installInteractivePrint :: GHC.GhcMonad m => Maybe String -> Bool -> m ()
installInteractivePrint :: forall (m :: Type -> Type).
GhcMonad m =>
Maybe [Char] -> Bool -> m ()
installInteractivePrint Maybe [Char]
Nothing Bool
_ = () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
installInteractivePrint (Just [Char]
ipFun) Bool
exprmode = do
SuccessFlag
ok <- m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ do
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
ipFun
let name :: Name
name = case [Name]
names of
Name
name':[Name]
_ -> Name
name'
[] -> [Char] -> Name
forall a. [Char] -> a
panic [Char]
"installInteractivePrint"
(HscEnv -> HscEnv) -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
(HscEnv -> HscEnv) -> m ()
modifySession (\HscEnv
he -> let new_ic :: InteractiveContext
new_ic = InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName (HscEnv -> InteractiveContext
hsc_IC HscEnv
he) Name
name
in HscEnv
he{hsc_IC :: InteractiveContext
hsc_IC = InteractiveContext
new_ic})
SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Succeeded
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (SuccessFlag -> Bool
failed SuccessFlag
ok Bool -> Bool -> Bool
&& Bool
exprmode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1))
runCommands :: InputT GHCi (Maybe String) -> InputT GHCi ()
runCommands :: InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands InputT GHCi (Maybe [Char])
gCmd = (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
forall (m :: Type -> Type). GhciMonad m => SomeException -> m Bool
handler Maybe (GHCi ())
forall a. Maybe a
Nothing InputT GHCi (Maybe [Char])
gCmd InputT GHCi () -> InputT GHCi () -> InputT GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
runCommands' :: (SomeException -> GHCi Bool)
-> 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 (m :: Type -> Type) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi ())
-> InputT GHCi ())
-> ((forall a. InputT GHCi a -> InputT GHCi a) -> InputT GHCi ())
-> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ \forall a. InputT GHCi a -> InputT GHCi a
unmask -> do
Maybe Bool
b <- (SomeException -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\SomeException
e -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just AsyncException
UserInterrupt -> Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> InputT GHCi (Maybe Bool))
-> Maybe Bool -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
Maybe AsyncException
_ -> case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just GhcException
ghce ->
do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (GhcException -> IO ()
forall a. Show a => a -> IO ()
print (GhcException
ghce :: GhcException))
Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
Maybe GhcException
_other ->
IO (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO (Maybe Bool)
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e))
(InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a. InputT GHCi a -> InputT GHCi a
unmask (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ (SomeException -> GHCi Bool)
-> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe Bool)
runOneCommand SomeException -> GHCi Bool
eh InputT GHCi (Maybe [Char])
gCmd)
case Maybe Bool
b of
Maybe Bool
Nothing -> () -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just Bool
success -> do
Bool -> InputT GHCi () -> InputT GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
success (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ InputT GHCi ()
-> (GHCi () -> InputT GHCi ()) -> Maybe (GHCi ()) -> InputT GHCi ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> InputT GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) GHCi () -> InputT GHCi ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Maybe (GHCi ())
sourceErrorHandler
InputT GHCi () -> InputT GHCi ()
forall a. InputT GHCi a -> InputT GHCi a
unmask (InputT GHCi () -> InputT GHCi ())
-> InputT GHCi () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> GHCi Bool)
-> Maybe (GHCi ()) -> InputT GHCi (Maybe [Char]) -> InputT GHCi ()
runCommands' SomeException -> GHCi Bool
eh Maybe (GHCi ())
sourceErrorHandler InputT GHCi (Maybe [Char])
gCmd
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 (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GHCi (Maybe [Char])
forall (m :: Type -> Type). GhciMonad m => m (Maybe [Char])
queryQueue)
Maybe [Char]
mb_cmd1 <- InputT GHCi (Maybe [Char])
-> ([Char] -> InputT GHCi (Maybe [Char]))
-> Maybe [Char]
-> InputT GHCi (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall {m :: Type -> Type}.
GhciMonad m =>
m (Maybe [Char]) -> m (Maybe [Char])
noSpace InputT GHCi (Maybe [Char])
gCmd) (Maybe [Char] -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> InputT GHCi (Maybe [Char]))
-> ([Char] -> Maybe [Char]) -> [Char] -> InputT GHCi (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just) Maybe [Char]
mb_cmd0
case Maybe [Char]
mb_cmd1 of
Maybe [Char]
Nothing -> Maybe Bool -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
Just [Char]
c -> do
GHCiState
st <- InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
(SomeException -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
e -> GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ SomeException -> GHCi Bool
eh SomeException
e GHCi Bool -> (Bool -> GHCi (Maybe Bool)) -> GHCi (Maybe Bool)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Bool -> GHCi (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> GHCi (Maybe Bool))
-> (Bool -> Maybe Bool) -> Bool -> GHCi (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool
forall a. a -> Maybe a
Just) (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
(SourceError -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> InputT GHCi (Maybe Bool)
forall {m :: Type -> Type}.
GhcMonad m =>
SourceError -> m (Maybe Bool)
printErrorAndFail (InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool))
-> InputT GHCi (Maybe Bool) -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
GHCiState -> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
cmd_wrapper GHCiState
st (InputT GHCi CommandResult -> InputT GHCi (Maybe Bool))
-> InputT GHCi CommandResult -> InputT GHCi (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT GHCi CommandResult
doCommand [Char]
c
where
printErrorAndFail :: SourceError -> m (Maybe Bool)
printErrorAndFail SourceError
err = do
SourceError -> m ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
err
Maybe Bool -> m (Maybe Bool)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
noSpace :: m (Maybe [Char]) -> m (Maybe [Char])
noSpace m (Maybe [Char])
q = m (Maybe [Char])
q m (Maybe [Char])
-> (Maybe [Char] -> m (Maybe [Char])) -> m (Maybe [Char])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe [Char])
-> ([Char] -> m (Maybe [Char])) -> Maybe [Char] -> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing)
(\[Char]
c -> case [Char] -> [Char]
removeSpaces [Char]
c of
[Char]
"" -> m (Maybe [Char]) -> m (Maybe [Char])
noSpace m (Maybe [Char])
q
[Char]
":{" -> m (Maybe [Char]) -> m (Maybe [Char])
forall {m :: Type -> Type}.
GhciMonad m =>
m (Maybe [Char]) -> m (Maybe [Char])
multiLineCmd m (Maybe [Char])
q
[Char]
_ -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c) )
multiLineCmd :: m (Maybe [Char]) -> m (Maybe [Char])
multiLineCmd m (Maybe [Char])
q = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let p :: PromptFunction
p = GHCiState -> PromptFunction
prompt GHCiState
st
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ prompt :: PromptFunction
prompt = GHCiState -> PromptFunction
prompt_cont GHCiState
st }
Maybe [Char]
mb_cmd <- m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
forall {m :: Type -> Type}.
MonadIO m =>
m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q [Char]
"" m (Maybe [Char]) -> m () -> m (Maybe [Char])
forall (m :: Type -> Type) a b. MonadMask m => m a -> m b -> m a
`MC.finally`
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st' -> GHCiState
st' { prompt :: PromptFunction
prompt = PromptFunction
p })
Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
mb_cmd
collectCommand :: m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q [Char]
c = m (Maybe [Char])
q m (Maybe [Char])
-> (Maybe [Char] -> m (Maybe [Char])) -> m (Maybe [Char])
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>=
m (Maybe [Char])
-> ([Char] -> m (Maybe [Char])) -> Maybe [Char] -> m (Maybe [Char])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IOException -> IO (Maybe [Char])
forall a. IOException -> IO a
ioError IOException
collectError))
(\[Char]
l->if [Char] -> [Char]
removeSpaces [Char]
l [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
":}"
then Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c)
else m (Maybe [Char]) -> [Char] -> m (Maybe [Char])
collectCommand m (Maybe [Char])
q ([Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
normSpace [Char]
l))
where normSpace :: Char -> Char
normSpace Char
'\r' = Char
' '
normSpace Char
x = Char
x
collectError :: IOException
collectError = [Char] -> IOException
userError [Char]
"unterminated multiline command :{ .. :}"
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 Bool
result) <- (Bool -> Maybe Integer)
-> InputT GHCi Bool
-> InputT GHCi (ActionStats, Either SomeException Bool)
forall (m :: Type -> Type) a.
ExceptionMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runWithStats (Maybe Integer -> Bool -> Maybe Integer
forall a b. a -> b -> a
const Maybe Integer
forall a. Maybe a
Nothing) (InputT GHCi Bool
-> InputT GHCi (ActionStats, Either SomeException Bool))
-> InputT GHCi Bool
-> InputT GHCi (ActionStats, Either SomeException Bool)
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT GHCi Bool
specialCommand [Char]
cmd
let processResult :: Bool -> Maybe Bool
processResult Bool
True = Maybe Bool
forall a. Maybe a
Nothing
processResult Bool
False = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$ [Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
stmt' (Bool -> Maybe Bool
processResult (Bool -> Maybe Bool)
-> Either SomeException Bool -> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException Bool
result) ActionStats
stats
doCommand [Char]
stmt = do
let stmt_nl_cnt :: Int
stmt_nl_cnt = [()] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ () | Char
'\n' <- [Char]
stmt ]
Bool
ml <- GHCi Bool -> InputT GHCi Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool) -> GHCi Bool -> InputT GHCi Bool
forall a b. (a -> b) -> a -> b
$ GHCiOption -> GHCi Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
Multiline
if Bool
ml Bool -> Bool -> Bool
&& Int
stmt_nl_cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then do
Int
fst_line_num <- GHCiState -> Int
line_number (GHCiState -> Int) -> InputT GHCi GHCiState -> InputT GHCi Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
Maybe [Char]
mb_stmt <- [Char] -> InputT GHCi (Maybe [Char]) -> InputT GHCi (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
checkInputForLayout [Char]
stmt InputT GHCi (Maybe [Char])
gCmd
case Maybe [Char]
mb_stmt of
Maybe [Char]
Nothing -> CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return CommandResult
CommandIncomplete
Just [Char]
ml_stmt -> do
(ActionStats
stats, Either SomeException (Maybe ExecResult)
result) <- (Maybe ExecResult -> Maybe Integer)
-> InputT GHCi (Maybe ExecResult)
-> InputT
GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall (m :: Type -> Type) a.
GhciMonad m =>
(a -> Maybe Integer)
-> m a -> m (ActionStats, Either SomeException a)
runAndPrintStats Maybe ExecResult -> Maybe Integer
runAllocs (InputT GHCi (Maybe ExecResult)
-> InputT
GHCi (ActionStats, Either SomeException (Maybe ExecResult)))
-> InputT GHCi (Maybe ExecResult)
-> InputT
GHCi (ActionStats, Either SomeException (Maybe ExecResult))
forall a b. (a -> b) -> a -> b
$ GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
fst_line_num [Char]
ml_stmt SingleStep
GHC.RunToCompletion
CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$
[Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
ml_stmt (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Maybe ExecResult -> Bool) -> Maybe ExecResult -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ExecResult -> Bool
runSuccess (Maybe ExecResult -> Maybe Bool)
-> Either SomeException (Maybe ExecResult)
-> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Maybe ExecResult)
result) ActionStats
stats
else do
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 (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 (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult))
-> GHCi (Maybe ExecResult) -> InputT GHCi (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
fst_line_num [Char]
stmt' SingleStep
GHC.RunToCompletion
CommandResult -> InputT GHCi CommandResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CommandResult -> InputT GHCi CommandResult)
-> CommandResult -> InputT GHCi CommandResult
forall a b. (a -> b) -> a -> b
$ [Char]
-> Either SomeException (Maybe Bool)
-> ActionStats
-> CommandResult
CommandComplete [Char]
stmt' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Maybe ExecResult -> Bool) -> Maybe ExecResult -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ExecResult -> Bool
runSuccess (Maybe ExecResult -> Maybe Bool)
-> Either SomeException (Maybe ExecResult)
-> Either SomeException (Maybe Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Maybe ExecResult)
result) ActionStats
stats
runStmtWithLineNum :: Int -> String -> SingleStep
-> GHCi (Maybe GHC.ExecResult)
runStmtWithLineNum :: Int -> [Char] -> SingleStep -> GHCi (Maybe ExecResult)
runStmtWithLineNum Int
lnum [Char]
stmt SingleStep
step = do
GHCiState
st0 <- GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
GHCiState -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st0 { line_number :: Int
line_number = Int
lnum }
Maybe ExecResult
result <- [Char] -> SingleStep -> GHCi (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
stmt SingleStep
step
GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState GHCi GHCiState -> (GHCiState -> GHCi ()) -> GHCi ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GHCiState
st -> GHCiState -> GHCi ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st { line_number :: Int
line_number = GHCiState -> Int
line_number GHCiState
st0 }
Maybe ExecResult -> GHCi (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
result
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 = DynFlags -> StringBuffer -> RealSrcLoc -> PState
Lexer.mkPState DynFlags
dflags StringBuffer
buf' RealSrcLoc
loc
case P Bool -> PState -> ParseResult Bool
forall a. P a -> PState -> ParseResult a
Lexer.unP P Bool
goToEnd PState
pstate of
(Lexer.POk PState
_ Bool
False) -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stmt
ParseResult Bool
_other -> do
GHCiState
st1 <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let p :: PromptFunction
p = GHCiState -> PromptFunction
prompt GHCiState
st1
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st1{ prompt :: PromptFunction
prompt = GHCiState -> PromptFunction
prompt_cont GHCiState
st1 }
Maybe [Char]
mb_stmt <- (SomeException -> m (Maybe [Char]))
-> m (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a.
(HasDynFlags m, ExceptionMonad m) =>
(SomeException -> m a) -> m a -> m a
ghciHandle (\SomeException
ex -> case SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
Just AsyncException
UserInterrupt -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
Maybe AsyncException
_ -> case SomeException -> Maybe GhcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
ex of
Just GhcException
ghce ->
do IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (GhcException -> IO ()
forall a. Show a => a -> IO ()
print (GhcException
ghce :: GhcException))
Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
Maybe GhcException
_other -> IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO (Maybe [Char])
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
ex))
m (Maybe [Char])
getStmt
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st' -> GHCiState
st' { prompt :: PromptFunction
prompt = PromptFunction
p })
case Maybe [Char]
mb_stmt of
Maybe [Char]
Nothing -> Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
Just [Char]
str -> if [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
then Maybe [Char] -> m (Maybe [Char])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
stmt
else do
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe [Char]) -> m (Maybe [Char])
checkInputForLayout ([Char]
stmt[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
str) m (Maybe [Char])
getStmt
where goToEnd :: P Bool
goToEnd = do
Bool
eof <- P Bool
Lexer.nextIsEOF
if Bool
eof
then P Bool
Lexer.activeContext
else Bool -> (Located Token -> P (Located Token)) -> P (Located Token)
forall a. Bool -> (Located Token -> P a) -> P a
Lexer.lexer Bool
False Located Token -> P (Located Token)
forall (m :: Type -> Type) a. Monad m => a -> m a
return P (Located Token) -> P Bool -> P Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> P Bool
goToEnd
enqueueCommands :: GhciMonad m => [String] -> m ()
enqueueCommands :: forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]]
cmds = do
[[Char]]
cmds [[Char]] -> m () -> m ()
forall a b. NFData a => a -> b -> b
`deepseq` () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState ((GHCiState -> GHCiState) -> m ())
-> (GHCiState -> GHCiState) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCiState
st -> GHCiState
st{ cmdqueue :: [[Char]]
cmdqueue = [[Char]]
cmds [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ GHCiState -> [[Char]]
cmdqueue GHCiState
st }
runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
runStmt :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> SingleStep -> m (Maybe ExecResult)
runStmt [Char]
input SingleStep
step = do
ParserFlags
pflags <- DynFlags -> ParserFlags
Lexer.mkParserFlags (DynFlags -> ParserFlags) -> m DynFlags -> m ParserFlags
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getInteractiveDynFlags
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let source :: [Char]
source = GHCiState -> [Char]
progname GHCiState
st
let line :: Int
line = GHCiState -> Int
line_number GHCiState
st
if | ParserFlags -> [Char] -> Bool
GHC.isStmt ParserFlags
pflags [Char]
input -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
Maybe (GhciLStmt GhcPs)
mb_stmt <- IO (Maybe (GhciLStmt GhcPs)) -> m (Maybe (GhciLStmt GhcPs))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv
-> Hsc (Maybe (GhciLStmt GhcPs)) -> IO (Maybe (GhciLStmt GhcPs))
forall a. HscEnv -> Hsc a -> IO a
runInteractiveHsc HscEnv
hsc_env ([Char] -> Int -> [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
hscParseStmtWithLocation [Char]
source Int
line [Char]
input))
case Maybe (GhciLStmt GhcPs)
mb_stmt of
Maybe (GhciLStmt GhcPs)
Nothing ->
Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just ExecResult
exec_complete)
Just GhciLStmt GhcPs
stmt ->
GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt GhciLStmt GhcPs
stmt
| ParserFlags -> [Char] -> Bool
GHC.isImport ParserFlags
pflags [Char]
input -> m (Maybe ExecResult)
run_import
| ParserFlags -> [Char] -> Bool
GHC.hasImport ParserFlags
pflags [Char]
input -> GhcException -> m (Maybe ExecResult)
forall a. GhcException -> a
throwGhcException
([Char] -> GhcException
CmdLineError [Char]
"error: expecting a single import declaration")
| Bool
otherwise -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[LHsDecl GhcPs]
decls <- IO [LHsDecl GhcPs] -> m [LHsDecl GhcPs]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> [Char] -> Int -> [Char] -> IO [LHsDecl GhcPs]
hscParseDeclsWithLocation HscEnv
hsc_env [Char]
source Int
line [Char]
input)
[LHsDecl GhcPs] -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe ExecResult)
run_decls [LHsDecl GhcPs]
decls
where
exec_complete :: ExecResult
exec_complete = Either SomeException [Name] -> Word64 -> ExecResult
GHC.ExecComplete ([Name] -> Either SomeException [Name]
forall a b. b -> Either a b
Right []) Word64
0
run_import :: m (Maybe ExecResult)
run_import = do
[Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
addImportToContext [Char]
input
Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just ExecResult
exec_complete)
run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult)
run_stmt :: forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt GhciLStmt GhcPs
stmt = do
Maybe ExecResult
m_result <- GhciLStmt GhcPs -> [Char] -> SingleStep -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> [Char] -> SingleStep -> m (Maybe ExecResult)
GhciMonad.runStmt GhciLStmt GhcPs
stmt [Char]
input SingleStep
step
case Maybe ExecResult
m_result of
Maybe ExecResult
Nothing -> Maybe ExecResult -> m (Maybe ExecResult)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe ExecResult
forall a. Maybe a
Nothing
Just ExecResult
result -> ExecResult -> Maybe ExecResult
forall a. a -> Maybe a
Just (ExecResult -> Maybe ExecResult)
-> m ExecResult -> m (Maybe ExecResult)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) ExecResult
result
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 SrcSpan
l (ValD XValD GhcPs
_ bind :: HsBind GhcPs
bind@FunBind{})] = GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt (SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
l HsBind GhcPs
bind)
run_decls [L SrcSpan
l (ValD XValD GhcPs
_ bind :: HsBind GhcPs
bind@VarBind{})] = GhciLStmt GhcPs -> m (Maybe ExecResult)
forall (m :: Type -> Type).
GhciMonad m =>
GhciLStmt GhcPs -> m (Maybe ExecResult)
run_stmt (SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
l HsBind GhcPs
bind)
run_decls [LHsDecl GhcPs]
decls = do
Either IOException ()
_ <- IO (Either IOException ()) -> m (Either IOException ())
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ()) -> m (Either IOException ()))
-> IO (Either IOException ()) -> m (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall a. IO a -> IO (Either IOException a)
tryIO (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlushAll Handle
stdin
Maybe [Name]
m_result <- [LHsDecl GhcPs] -> m (Maybe [Name])
forall (m :: Type -> Type).
GhciMonad m =>
[LHsDecl GhcPs] -> m (Maybe [Name])
GhciMonad.runDecls' [LHsDecl GhcPs]
decls
Maybe [Name] -> ([Name] -> m ExecResult) -> m (Maybe ExecResult)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe [Name]
m_result (([Name] -> m ExecResult) -> m (Maybe ExecResult))
-> ([Name] -> m ExecResult) -> m (Maybe ExecResult)
forall a b. (a -> b) -> a -> b
$ \[Name]
result ->
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt (Bool -> SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True) (Either SomeException [Name] -> Word64 -> ExecResult
GHC.ExecComplete ([Name] -> Either SomeException [Name]
forall a b. b -> Either a b
Right [Name]
result) Word64
0)
mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt SrcSpan
loc HsBind GhcPs
bind =
let l :: e -> GenLocated SrcSpan e
l = SrcSpan -> e -> GenLocated SrcSpan e
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc
in StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> GhciLStmt GhcPs
forall {e}. e -> GenLocated SrcSpan e
l (XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsLocalBindsLR GhcPs GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
NoExtField
noExtField (HsLocalBindsLR GhcPs GhcPs -> LHsLocalBindsLR GhcPs GhcPs
forall {e}. e -> GenLocated SrcSpan e
l (XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
NoExtField
noExtField (XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
NoExtField
noExtField (GenLocated SrcSpan (HsBind GhcPs) -> LHsBindsLR GhcPs GhcPs
forall a. a -> Bag a
unitBag (HsBind GhcPs -> GenLocated SrcSpan (HsBind GhcPs)
forall {e}. e -> GenLocated SrcSpan e
l HsBind GhcPs
bind)) []))))
afterRunStmt :: GhciMonad m
=> (SrcSpan -> Bool) -> GHC.ExecResult -> m GHC.ExecResult
afterRunStmt :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt SrcSpan -> Bool
step_here ExecResult
run_result = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case ExecResult
run_result of
GHC.ExecComplete{Word64
Either SomeException [Name]
execAllocation :: ExecResult -> Word64
execResult :: ExecResult -> Either SomeException [Name]
execAllocation :: Word64
execResult :: Either SomeException [Name]
..} ->
case Either SomeException [Name]
execResult of
Left SomeException
ex -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
ex
Right [Name]
names -> do
Bool
show_types <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
ShowType
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
show_types (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
GHC.ExecBreak [Name]
names Maybe BreakInfo
mb_info
| Maybe BreakInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe BreakInfo
mb_info Bool -> Bool -> Bool
||
SrcSpan -> Bool
step_here (Resume -> SrcSpan
GHC.resumeSpan (Resume -> SrcSpan) -> Resume -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [Resume] -> Resume
forall a. [a] -> a
head [Resume]
resumes) -> do
Maybe (Int, BreakLocation)
mb_id_loc <- Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type).
GhciMonad m =>
Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Maybe BreakInfo
mb_info
let bCmd :: [Char]
bCmd = [Char]
-> ((Int, BreakLocation) -> [Char])
-> Maybe (Int, BreakLocation)
-> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ( \(Int
_,BreakLocation
l) -> BreakLocation -> [Char]
onBreakCmd BreakLocation
l ) Maybe (Int, BreakLocation)
mb_id_loc
if ([Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
bCmd)
then Resume -> [Name] -> m ()
forall (m :: Type -> Type). GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo ([Resume] -> Resume
forall a. [a] -> a
head [Resume]
resumes) [Name]
names
else [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [[Char]
bCmd]
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
[[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands [GHCiState -> [Char]
stop GHCiState
st]
() -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
| Bool
otherwise -> (SrcSpan -> Bool) -> SingleStep -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ExecResult
resume SrcSpan -> Bool
step_here SingleStep
GHC.SingleStep m ExecResult -> (ExecResult -> m ExecResult) -> m ExecResult
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> ExecResult -> m ExecResult
afterRunStmt SrcSpan -> Bool
step_here m ExecResult -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
flushInterpBuffers
m () -> m ()
forall (m :: Type -> Type) a. ExceptionMonad m => m a -> m a
withSignalHandlers (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
b <- GHCiOption -> m Bool
forall (m :: Type -> Type). GhciMonad m => GHCiOption -> m Bool
isOptionSet GHCiOption
RevertCAFs
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
forall (m :: Type -> Type). GhciMonad m => m ()
revertCAFs
ExecResult -> m ExecResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExecResult
run_result
runSuccess :: Maybe GHC.ExecResult -> Bool
runSuccess :: Maybe ExecResult -> Bool
runSuccess Maybe ExecResult
run_result
| Just (GHC.ExecComplete { execResult :: ExecResult -> Either SomeException [Name]
execResult = Right [Name]
_ }) <- Maybe ExecResult
run_result = Bool
True
| Bool
otherwise = Bool
False
runAllocs :: Maybe GHC.ExecResult -> Maybe Integer
runAllocs :: Maybe ExecResult -> Maybe Integer
runAllocs Maybe ExecResult
m = do
ExecResult
res <- Maybe ExecResult
m
case ExecResult
res of
GHC.ExecComplete{Word64
Either SomeException [Name]
execAllocation :: Word64
execResult :: Either SomeException [Name]
execAllocation :: ExecResult -> Word64
execResult :: ExecResult -> Either SomeException [Name]
..} -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
execAllocation)
ExecResult
_ -> Maybe Integer
forall a. Maybe a
Nothing
toBreakIdAndLocation :: GhciMonad m
=> Maybe GHC.BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation :: forall (m :: Type -> Type).
GhciMonad m =>
Maybe BreakInfo -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Maybe BreakInfo
Nothing = Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (Int, BreakLocation)
forall a. Maybe a
Nothing
toBreakIdAndLocation (Just BreakInfo
inf) = do
let md :: Module
md = BreakInfo -> Module
GHC.breakInfo_module BreakInfo
inf
nm :: Int
nm = BreakInfo -> Int
GHC.breakInfo_number BreakInfo
inf
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation)))
-> Maybe (Int, BreakLocation) -> m (Maybe (Int, BreakLocation))
forall a b. (a -> b) -> a -> b
$ [(Int, BreakLocation)] -> Maybe (Int, BreakLocation)
forall a. [a] -> Maybe a
listToMaybe [ (Int, BreakLocation)
id_loc | id_loc :: (Int, BreakLocation)
id_loc@(Int
_,BreakLocation
loc) <- IntMap BreakLocation -> [(Int, BreakLocation)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (GHCiState -> IntMap BreakLocation
breaks GHCiState
st),
BreakLocation -> Module
breakModule BreakLocation
loc Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
md,
BreakLocation -> Int
breakTick BreakLocation
loc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nm ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo :: forall (m :: Type -> Type). GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo Resume
res [Name]
names = do
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ Resume -> SDoc
pprStopped Resume
res
let namesSorted :: [Name]
namesSorted = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
compareNames [Name]
names
[TyThing]
tythings <- [Maybe TyThing] -> [TyThing]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TyThing] -> [TyThing]) -> m [Maybe TyThing] -> m [TyThing]
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
`liftM` (Name -> m (Maybe TyThing)) -> [Name] -> m [Maybe TyThing]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName [Name]
namesSorted
[SDoc]
docs <- (Id -> m SDoc) -> [Id] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Id -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Id -> m SDoc
pprTypeAndContents [Id
i | AnId Id
i <- [TyThing]
tythings]
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUserPartWay (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [SDoc]
docs
printTypeOfNames :: GHC.GhcMonad m => [Name] -> m ()
printTypeOfNames :: forall (m :: Type -> Type). GhcMonad m => [Name] -> m ()
printTypeOfNames [Name]
names
= (Name -> m ()) -> [Name] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Name -> m ()
forall (m :: Type -> Type). GhcMonad m => Name -> m ()
printTypeOfName ) ([Name] -> m ()) -> [Name] -> m ()
forall a b. (a -> b) -> a -> b
$ (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
compareNames [Name]
names
compareNames :: Name -> Name -> Ordering
Name
n1 compareNames :: Name -> Name -> Ordering
`compareNames` Name
n2 =
([Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (Name -> [Char]) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> [Char]
forall a. NamedThing a => a -> [Char]
getOccString) Name
n1 Name
n2 Ordering -> Ordering -> Ordering
`thenCmp`
(SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan) Name
n1 Name
n2
printTypeOfName :: GHC.GhcMonad m => Name -> m ()
printTypeOfName :: forall (m :: Type -> Type). GhcMonad m => Name -> m ()
printTypeOfName Name
n
= do Maybe TyThing
maybe_tything <- Name -> m (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName Name
n
case Maybe TyThing
maybe_tything of
Maybe TyThing
Nothing -> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just TyThing
thing -> TyThing -> m ()
forall (m :: Type -> Type). GhcMonad m => TyThing -> m ()
printTyThing TyThing
thing
data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
specialCommand :: String -> InputT GHCi Bool
specialCommand :: [Char] -> InputT GHCi Bool
specialCommand (Char
'!':[Char]
str) = GHCi Bool -> InputT GHCi Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool) -> GHCi Bool -> InputT GHCi Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> GHCi Bool
forall (m :: Type -> Type). MonadIO m => [Char] -> m Bool
shellEscape ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
str)
specialCommand [Char]
str = do
let ([Char]
cmd,[Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
str
MaybeCommand
maybe_cmd <- [Char] -> InputT GHCi MaybeCommand
forall (m :: Type -> Type). GhciMonad m => [Char] -> m MaybeCommand
lookupCommand [Char]
cmd
[Char]
htxt <- GHCiState -> [Char]
short_help (GHCiState -> [Char])
-> InputT GHCi GHCiState -> InputT GHCi [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> InputT GHCi GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
case MaybeCommand
maybe_cmd of
GotCommand Command
cmd -> (Command -> [Char] -> InputT GHCi Bool
cmdAction Command
cmd) ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
MaybeCommand
BadCommand ->
do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
stdout ([Char]
"unknown command ':" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
htxt)
Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
MaybeCommand
NoLastCommand ->
do IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
stdout ([Char]
"there is no last command to perform\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
htxt)
Bool -> InputT GHCi Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
shellEscape :: MonadIO m => String -> m Bool
shellEscape :: forall (m :: Type -> Type). MonadIO m => [Char] -> m Bool
shellEscape [Char]
str = IO Bool -> m Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ExitCode
system [Char]
str IO ExitCode -> IO Bool -> IO Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False)
lookupCommand :: GhciMonad m => String -> m (MaybeCommand)
lookupCommand :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m MaybeCommand
lookupCommand [Char]
"" = do
GHCiState
st <- m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
case GHCiState -> Maybe Command
last_command GHCiState
st of
Just Command
c -> MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MaybeCommand -> m MaybeCommand) -> MaybeCommand -> m MaybeCommand
forall a b. (a -> b) -> a -> b
$ Command -> MaybeCommand
GotCommand Command
c
Maybe Command
Nothing -> MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return MaybeCommand
NoLastCommand
lookupCommand [Char]
str = do
Maybe Command
mc <- [Char] -> m (Maybe Command)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
str
(GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { last_command :: Maybe Command
last_command = Maybe Command
mc })
MaybeCommand -> m MaybeCommand
forall (m :: Type -> Type) a. Monad m => a -> m a
return (MaybeCommand -> m MaybeCommand) -> MaybeCommand -> m MaybeCommand
forall a b. (a -> b) -> a -> b
$ case Maybe Command
mc of
Just Command
c -> Command -> MaybeCommand
GotCommand Command
c
Maybe Command
Nothing -> MaybeCommand
BadCommand
lookupCommand' :: GhciMonad m => String -> m (Maybe Command)
lookupCommand' :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Command)
lookupCommand' [Char]
":" = Maybe Command -> m (Maybe Command)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Command
forall a. Maybe a
Nothing
lookupCommand' [Char]
str' = do
[Command]
macros <- GHCiState -> [Command]
ghci_macros (GHCiState -> [Command]) -> m GHCiState -> m [Command]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
[Command]
ghci_cmds <- GHCiState -> [Command]
ghci_commands (GHCiState -> [Command]) -> m GHCiState -> m [Command]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
let ghci_cmds_nohide :: [Command]
ghci_cmds_nohide = (Command -> Bool) -> [Command] -> [Command]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Command -> Bool) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Bool
cmdHidden) [Command]
ghci_cmds
let ([Char]
str, [Command]
xcmds) = case [Char]
str' of
Char
':' : [Char]
rest -> ([Char]
rest, [])
[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 (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Command -> m (Maybe Command))
-> Maybe Command -> m (Maybe Command)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact [Char]
str [Command]
xcmds Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
[Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact [Char]
str [Command]
ghci_cmds Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
(Maybe Command
builtinPfxMatch Maybe Command -> (Command -> Maybe Command) -> Maybe Command
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Command
c -> [Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupExact (Command -> [Char]
cmdName Command
c) [Command]
xcmds) Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
Maybe Command
builtinPfxMatch Maybe Command -> Maybe Command -> Maybe Command
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|>
[Char] -> [Command] -> Maybe Command
forall {t :: Type -> Type}.
Foldable t =>
[Char] -> t Command -> Maybe Command
lookupPrefix [Char]
str [Command]
xcmds
isPrefixOptOf :: String -> String -> Bool
isPrefixOptOf :: [Char] -> [Char] -> Bool
isPrefixOptOf [Char]
s [Char]
x = let ([Char]
body, [Char]
opt) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') [Char]
s
in ([Char]
body [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x) Bool -> Bool -> Bool
&& ([Char]
opt [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
x)
getCurrentBreakSpan :: GHC.GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan :: forall (m :: Type -> Type). GhcMonad m => m (Maybe SrcSpan)
getCurrentBreakSpan = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe SrcSpan
forall a. Maybe a
Nothing
(Resume
r:[Resume]
_) -> do
let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just (Resume -> SrcSpan
GHC.resumeSpan Resume
r))
else do
let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
SrcSpan
pan <- History -> m SrcSpan
forall (m :: Type -> Type). GhcMonad m => History -> m SrcSpan
GHC.getHistorySpan History
hist
Maybe SrcSpan -> m (Maybe SrcSpan)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
pan)
getCallStackAtCurrentBreakpoint :: GHC.GhcMonad m => m (Maybe [String])
getCallStackAtCurrentBreakpoint :: forall (m :: Type -> Type). GhcMonad m => m (Maybe [[Char]])
getCallStackAtCurrentBreakpoint = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> Maybe [[Char]] -> m (Maybe [[Char]])
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe [[Char]]
forall a. Maybe a
Nothing
(Resume
r:[Resume]
_) -> do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]]) -> m [[Char]] -> m (Maybe [[Char]])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]] -> m [[Char]]
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> RemotePtr CostCentreStack -> IO [[Char]]
costCentreStackInfo HscEnv
hsc_env (Resume -> RemotePtr CostCentreStack
GHC.resumeCCS Resume
r))
getCurrentBreakModule :: GHC.GhcMonad m => m (Maybe Module)
getCurrentBreakModule :: forall (m :: Type -> Type). GhcMonad m => m (Maybe Module)
getCurrentBreakModule = do
[Resume]
resumes <- m [Resume]
forall (m :: Type -> Type). GhcMonad m => m [Resume]
GHC.getResumeContext
case [Resume]
resumes of
[] -> Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe Module
forall a. Maybe a
Nothing
(Resume
r:[Resume]
_) -> do
let ix :: Int
ix = Resume -> Int
GHC.resumeHistoryIx Resume
r
if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BreakInfo -> Module
GHC.breakInfo_module (BreakInfo -> Module) -> Maybe BreakInfo -> Maybe Module
forall (m :: Type -> Type) a1 r.
Monad m =>
(a1 -> r) -> m a1 -> m r
`liftM` Resume -> Maybe BreakInfo
GHC.resumeBreakInfo Resume
r)
else do
let hist :: History
hist = Resume -> [History]
GHC.resumeHistory Resume
r [History] -> Int -> History
forall a. [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Maybe Module -> m (Maybe Module)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe Module -> m (Maybe Module))
-> Maybe Module -> m (Maybe Module)
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just (Module -> Maybe Module) -> Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ History -> Module
GHC.getHistoryModule History
hist
noArgs :: MonadIO m => m () -> String -> m ()
noArgs :: forall (m :: Type -> Type). MonadIO m => m () -> [Char] -> m ()
noArgs m ()
m [Char]
"" = m ()
m
noArgs m ()
_ [Char]
_ = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"This command takes no arguments"
withSandboxOnly :: GHC.GhcMonad m => String -> m () -> m ()
withSandboxOnly :: forall (m :: Type -> Type). GhcMonad m => [Char] -> m () -> m ()
withSandboxOnly [Char]
cmd m ()
this = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciSandbox DynFlags
dflags)
then SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
text [Char]
cmd SDoc -> SDoc -> SDoc
<+>
PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"is not supported with -fno-ghci-sandbox"))
else m ()
this
help :: GhciMonad m => String -> m ()
help :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
help [Char]
_ = do
[Char]
txt <- GHCiState -> [Char]
long_help (GHCiState -> [Char]) -> m GHCiState -> m [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m GHCiState
forall (m :: Type -> Type). GhciMonad m => m GHCiState
getGHCiState
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
txt
info :: GHC.GhcMonad m => Bool -> String -> m ()
info :: forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m ()
info Bool
_ [Char]
"" = GhcException -> m ()
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError [Char]
"syntax: ':i <thing-you-want-info-about>'")
info Bool
allInfo [Char]
s = (SourceError -> m ()) -> m () -> m ()
forall (m :: Type -> Type) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> m ()
forall (m :: Type -> Type). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
[SDoc]
sdocs <- ([Char] -> m SDoc) -> [[Char]] -> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> [Char] -> m SDoc
forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m SDoc
infoThing Bool
allInfo) ([Char] -> [[Char]]
words [Char]
s)
(SDoc -> m ()) -> [SDoc] -> m ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SDoc -> IO ()) -> SDoc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (SDoc -> [Char]) -> SDoc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
unqual) [SDoc]
sdocs
infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
infoThing :: forall (m :: Type -> Type). GhcMonad m => Bool -> [Char] -> m SDoc
infoThing Bool
allInfo [Char]
str = do
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
str
[Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs <- (Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
-> [Name]
-> m [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
forall (m :: Type -> Type).
GhcMonad m =>
Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
GHC.getInfo Bool
allInfo) [Name]
names
let filtered :: [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered = ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> TyThing)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (\(TyThing
t,Fixity
_f,[ClsInst]
_ci,[FamInst]
_fi,SDoc
_sd) -> TyThing
t)
([Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs)
SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> SDoc
text [Char]
"") ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprInfo [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered)
filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren :: forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren a -> TyThing
get_thing [a]
xs
= (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filterOut a -> Bool
has_parent [a]
xs
where
all_names :: NameSet
all_names = [Name] -> NameSet
mkNameSet ((a -> Name) -> [a] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (TyThing -> Name
forall a. NamedThing a => a -> Name
getName (TyThing -> Name) -> (a -> TyThing) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TyThing
get_thing) [a]
xs)
has_parent :: a -> Bool
has_parent a
x = case TyThing -> Maybe TyThing
tyThingParent_maybe (a -> TyThing
get_thing a
x) of
Just TyThing
p -> TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
p Name -> NameSet -> Bool
`elemNameSet` NameSet
all_names
Maybe TyThing
Nothing -> Bool
False
pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
pprInfo :: (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprInfo (TyThing
thing, Fixity
fixity, [ClsInst]
cls_insts, [FamInst]
fam_insts, SDoc
docs)
= SDoc
docs
SDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
pprTyThingInContextLoc TyThing
thing
SDoc -> SDoc -> SDoc
$$ SDoc
show_fixity
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstance [ClsInst]
cls_insts)
SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((FamInst -> SDoc) -> [FamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst [FamInst]
fam_insts)
where
show_fixity :: SDoc
show_fixity
| Fixity
fixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
GHC.defaultFixity = SDoc
empty
| Bool
otherwise = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (TyThing -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyThing
thing)
runMain :: GhciMonad m => String -> m ()
runMain :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
runMain [Char]
s = case [Char] -> Either [Char] [[Char]]
toArgs [Char]
s of
Left [Char]
err -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
args ->
do DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let main :: [Char]
main = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"main" (DynFlags -> Maybe [Char]
mainFunIs DynFlags
dflags)
[[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 (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]
")"]
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 (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [Char]) -> m (Either IOException [Char]))
-> IO (Either IOException [Char]) -> m (Either IOException [Char])
forall a b. (a -> b) -> a -> b
$ IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO IO [Char]
getHomeDirectory
case Either IOException [Char]
either_dir of
Left IOException
_e -> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Right [Char]
dir -> [Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
changeDirectory [Char]
dir
changeDirectory [Char]
dir = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([ModSummary] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([ModSummary] -> Bool) -> [ModSummary] -> Bool
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearAllTargets
Bool -> [ModSummary] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [ModSummary] -> m ()
setContextAfterLoad Bool
False []
m ()
forall (m :: Type -> Type). GhcMonad m => m ()
GHC.workingDirectoryChanged
[Char]
dir' <- [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [Char]
dir
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
setCurrentDirectory [Char]
dir'
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
case HscEnv -> Maybe Interp
hsc_interp HscEnv
hsc_env of
Just (ExternalInterp {}) -> do
ForeignHValue
fhv <- [Char] -> m ForeignHValue
forall (m :: Type -> Type). GhcMonad m => [Char] -> m ForeignHValue
compileGHCiExpr ([Char] -> m ForeignHValue) -> [Char] -> m ForeignHValue
forall a b. (a -> b) -> a -> b
$
[Char]
"System.Directory.setCurrentDirectory " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
dir'
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> ForeignHValue -> IO ()
evalIO HscEnv
hsc_env ForeignHValue
fhv
Maybe Interp
_ -> () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag
trySuccess :: forall (m :: Type -> Type).
GhcMonad 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). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e
SuccessFlag -> m SuccessFlag
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 (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 (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 (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 (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 (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 (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 (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 (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 :: ModSummary -> f Bool
hasFailed ModSummary
x = (Bool -> Bool) -> f Bool -> f Bool
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
$ ModuleName -> f Bool
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Bool
GHC.isLoaded (ModuleName -> f Bool) -> ModuleName -> f Bool
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModuleName
GHC.ms_mod_name ModSummary
x
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
ModuleGraph
failed_graph <-
[ModSummary] -> ModuleGraph
GHC.mkModuleGraph ([ModSummary] -> ModuleGraph) -> m [ModSummary] -> m ModuleGraph
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModSummary -> m Bool) -> [ModSummary] -> m [ModSummary]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModSummary -> m Bool
forall {f :: Type -> Type}. GhcMonad f => ModSummary -> f Bool
hasFailed (ModuleGraph -> [ModSummary]
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
$ Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
True ModuleGraph
g Maybe ModuleName
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 (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 (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 (GHC.TargetFile [Char]
f Maybe Phase
_) Bool
_ Maybe (StringBuffer, UTCTime)
_) = [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 (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]
"macro name cannot start with a colon"
defineMacro Bool
_ (Char
'!':[Char]
_) = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn
[Char]
"macro name cannot start with an exclamation mark"
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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
macro_name
then if [[Char]] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
defined
then IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"no macros defined"
else IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char]
"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 (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 (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). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs
step <- m (LHsExpr GhcPs)
forall (m :: Type -> Type). GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO
LHsExpr 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 = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar IdP GhcPs
RdrName
stringTyCon_RDR
ioM :: LHsType GhcPs
ioM = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (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 (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
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
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
expr)
tySig :: LHsSigWcType GhcPs
tySig = LHsType GhcPs -> LHsSigWcType GhcPs
mkLHsSigWcType (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 :: LHsExpr GhcPs
new_expr = SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L (LHsExpr GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcPs
expr) (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr 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
NoExtField
noExtField LHsExpr GhcPs
body LHsSigWcType (NoGhcTc GhcPs)
LHsSigWcType GhcPs
tySig
ForeignHValue
hv <- LHsExpr GhcPs -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote LHsExpr GhcPs
new_expr
let newCmd :: Command
newCmd = Command :: [Char]
-> ([Char] -> InputT GHCi Bool)
-> Bool
-> CompletionFunc GHCi
-> Command
Command { cmdName :: [Char]
cmdName = [Char]
macro_name
, cmdAction :: [Char] -> InputT GHCi Bool
cmdAction = GHCi Bool -> InputT GHCi Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCi Bool -> InputT GHCi Bool)
-> ([Char] -> GHCi Bool) -> [Char] -> InputT GHCi Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignHValue -> [Char] -> GHCi Bool
forall (m :: Type -> Type).
GhciMonad m =>
ForeignHValue -> [Char] -> m Bool
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 :: [Command]
ghci_macros = Command
newCmd Command -> [Command] -> [Command]
forall a. a -> [a] -> [a]
: [Command]
filtered }
runMacro
:: GhciMonad m
=> GHC.ForeignHValue
-> String
-> m Bool
runMacro :: forall (m :: Type -> Type).
GhciMonad m =>
ForeignHValue -> [Char] -> m Bool
runMacro ForeignHValue
fun [Char]
s = do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[Char]
str <- IO [Char] -> m [Char]
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
$ HscEnv -> ForeignHValue -> [Char] -> IO [Char]
evalStringToIOString HscEnv
hsc_env ForeignHValue
fun [Char]
s
[[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
enqueueCommands ([Char] -> [[Char]]
lines [Char]
str)
Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
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 :: [Command]
ghci_macros = (Command -> Bool) -> [Command] -> [Command]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
macro_name) ([Char] -> Bool) -> (Command -> [Char]) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> [Char]
cmdName)
(GHCiState -> [Command]
ghci_macros GHCiState
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). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LHsExpr GhcPs
step <- m (LHsExpr GhcPs)
forall (m :: Type -> Type). GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO
LHsExpr 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
step LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
`mkHsApp` LHsExpr GhcPs
expr
ForeignHValue
hv <- LHsExpr GhcPs -> m ForeignHValue
forall (m :: Type -> Type).
GhcMonad m =>
LHsExpr GhcPs -> m ForeignHValue
GHC.compileParsedExprRemote LHsExpr GhcPs
new_expr
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
[Char]
cmds <- IO [Char] -> m [Char]
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
$ HscEnv -> ForeignHValue -> IO [Char]
evalString HscEnv
hsc_env 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 = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar IdP GhcPs
RdrName
stringTyCon_RDR
ghciM :: LHsType GhcPs
ghciM = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (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
stringTy
ioM :: LHsType GhcPs
ioM = IdP GhcPs -> LHsType GhcPs
forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar (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 (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
ghciStepIoMName)
tySig :: LHsSigWcType GhcPs
tySig = LHsType GhcPs -> LHsSigWcType GhcPs
mkLHsSigWcType (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)
LHsExpr GhcPs -> m (LHsExpr GhcPs)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LHsExpr GhcPs -> m (LHsExpr GhcPs))
-> LHsExpr GhcPs -> m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> LHsExpr GhcPs
forall {e}. e -> GenLocated SrcSpan e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr 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
NoExtField
noExtField LHsExpr GhcPs
body LHsSigWcType (NoGhcTc GhcPs)
LHsSigWcType 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). GhcMonad m => SourceError -> m ()
GHC.printException SourceError
e m () -> m Bool -> m Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False) (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 (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) = ASSERT( all isExternalName scope )
(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
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName (Module -> ModuleName) -> (Name -> Module) -> Name -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> Module
Name -> Module
GHC.nameModule) [Name]
scope
in
([Char] -> SDoc
text [Char]
"global names: " SDoc -> SDoc -> SDoc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
glob) SDoc -> SDoc -> SDoc
$$
([Char] -> SDoc
text [Char]
"local names: " SDoc -> SDoc -> SDoc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
loc)
ModuleInfo
_ -> SDoc
empty
Bool -> m Bool
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
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
s
[Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString)]
e_docss <- (Name
-> m (Either
GetDocsFailure (Maybe HsDocString, Map Int HsDocString)))
-> [Name]
-> m [Either
GetDocsFailure (Maybe HsDocString, Map Int HsDocString)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name
-> m (Either
GetDocsFailure (Maybe HsDocString, Map Int HsDocString))
forall (m :: Type -> Type).
GhcMonad m =>
Name
-> m (Either
GetDocsFailure (Maybe HsDocString, Map Int HsDocString))
GHC.getDocs [Name]
names
[SDoc]
sdocs <- (Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString)
-> m SDoc)
-> [Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString)]
-> m [SDoc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((GetDocsFailure -> m SDoc)
-> ((Maybe HsDocString, Map Int HsDocString) -> m SDoc)
-> Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString)
-> m SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GetDocsFailure -> m SDoc
forall (m :: Type -> Type). GhcMonad m => GetDocsFailure -> m SDoc
handleGetDocsFailure (SDoc -> m SDoc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SDoc -> m SDoc)
-> ((Maybe HsDocString, Map Int HsDocString) -> SDoc)
-> (Maybe HsDocString, Map Int HsDocString)
-> m SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe HsDocString, Map Int HsDocString) -> SDoc
pprDocs)) [Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString)]
e_docss
let sdocs' :: SDoc
sdocs' = [SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> SDoc
text [Char]
"") [SDoc]
sdocs)
PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
(IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SDoc -> IO ()) -> SDoc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (SDoc -> [Char]) -> SDoc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
unqual) SDoc
sdocs'
pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
pprDocs :: (Maybe HsDocString, Map Int HsDocString) -> SDoc
pprDocs (Maybe HsDocString
mb_decl_docs, Map Int HsDocString
_arg_docs) =
SDoc -> (HsDocString -> SDoc) -> Maybe HsDocString -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
([Char] -> SDoc
text [Char]
"<has no documentation>")
([Char] -> SDoc
text ([Char] -> SDoc) -> (HsDocString -> [Char]) -> HsDocString -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> [Char]
unpackHDS)
Maybe HsDocString
mb_decl_docs
handleGetDocsFailure :: GHC.GhcMonad m => GetDocsFailure -> m SDoc
handleGetDocsFailure :: forall (m :: Type -> Type). GhcMonad m => GetDocsFailure -> m SDoc
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 SDoc
forall a. GhcException -> a
throwGhcException (GhcException -> m SDoc) -> GhcException -> m SDoc
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). GhcMonad 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
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.
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 (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 Phase)] -> m SuccessFlag
loadModule :: forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule [([Char], 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 Phase)] -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule' [([Char], 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 (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 (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 Phase)] -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule ([[Char]] -> [Maybe Phase] -> [([Char], Maybe Phase)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
fs (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 Phase)] -> m SuccessFlag
loadModule' :: forall (m :: Type -> Type).
GhciMonad m =>
[([Char], Maybe Phase)] -> m SuccessFlag
loadModule' [([Char], Maybe Phase)]
files = do
let ([[Char]]
filenames, [Maybe Phase]
phases) = [([Char], Maybe Phase)] -> ([[Char]], [Maybe Phase])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Char], 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)
mapM [Char] -> m [Char]
forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath [[Char]]
filenames
let files' :: [([Char], Maybe Phase)]
files' = [[Char]] -> [Maybe Phase] -> [([Char], Maybe Phase)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
exp_filenames [Maybe Phase]
phases
[Target]
targets <- (([Char], Maybe Phase) -> m Target)
-> [([Char], 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)
mapM (([Char] -> Maybe Phase -> m Target)
-> ([Char], Maybe Phase) -> m Target
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe Phase -> m Target
GHC.guessTarget) [([Char], 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
LeakIndicators
leak_indicators <- if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciLeakCheck DynFlags
dflags
then IO LeakIndicators -> m LeakIndicators
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
else LeakIndicators -> m LeakIndicators
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> LeakIndicators
forall a. [Char] -> a
panic [Char]
"no leak indicators")
Bool
_ <- m Bool
forall (m :: Type -> Type). GhcMonad m => m Bool
GHC.abandonAll
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
clearAllTargets
[Target] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
targets
SuccessFlag
success <- Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
False LoadHowMuch
LoadAllTargets
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhciLeakCheck DynFlags
dflags) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> LeakIndicators -> IO ()
checkLeakIndicators DynFlags
dflags LeakIndicators
leak_indicators
SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
success
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)
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)
mapM (\[Char]
m -> [Char] -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe Phase -> m Target
GHC.guessTarget [Char]
m 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). GhcMonad 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
tid Bool
_ Maybe (StringBuffer, UTCTime)
_ <- [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 (m :: Type -> Type) a. Monad m => a -> m a
return ()
where
checkTarget :: GHC.GhcMonad m => Target -> m Bool
checkTarget :: forall (m :: Type -> Type). GhcMonad m => Target -> m Bool
checkTarget (Target (TargetModule ModuleName
m) Bool
_ Maybe (StringBuffer, UTCTime)
_) = ModuleName -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Bool
checkTargetModule ModuleName
m
checkTarget (Target (TargetFile [Char]
f Maybe Phase
_) Bool
_ Maybe (StringBuffer, UTCTime)
_) = IO Bool -> m Bool
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
checkTargetFile [Char]
f
checkTargetModule :: GHC.GhcMonad m => ModuleName -> m Bool
checkTargetModule :: forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Bool
checkTargetModule ModuleName
m = do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
FindResult
result <- IO FindResult -> m FindResult
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 -> Maybe FastString -> IO FindResult
Finder.findImportedModule HscEnv
hsc_env ModuleName
m (FastString -> Maybe FastString
forall a. a -> Maybe a
Just ([Char] -> FastString
fsLit [Char]
"this"))
case FindResult
result of
Found ModLocation
_ Module
_ -> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
FindResult
_ -> (IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[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 () -> m Bool -> m Bool
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
checkTargetFile :: String -> IO Bool
checkTargetFile :: [Char] -> IO Bool
checkTargetFile [Char]
f = do
Bool
exists <- ([Char] -> IO Bool
doesFileExist [Char]
f) :: IO Bool
Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
exists (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]
"File " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"
Bool -> IO Bool
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)
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)
mapM (\[Char]
m -> [Char] -> Maybe Phase -> m Target
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> Maybe Phase -> m Target
GHC.guessTarget [Char]
m 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
tid Bool
_ Maybe (StringBuffer, UTCTime)
_ <- [Target]
targets ]
SuccessFlag
_ <- Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
False LoadHowMuch
LoadAllTargets
() -> m ()
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 = 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
$ Bool -> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> LoadHowMuch -> m SuccessFlag
doLoadAndCollectInfo Bool
True LoadHowMuch
loadTargets
where
loadTargets :: LoadHowMuch
loadTargets | [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
m = LoadHowMuch
LoadAllTargets
| Bool
otherwise = ModuleName -> LoadHowMuch
LoadUpTo ([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
m ()
forall (m :: Type -> Type). GhciMonad m => m ()
resetOptByteCodeIfUnboxed
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 (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 ([ModuleName] -> m [ModuleName]) -> [ModuleName] -> m [ModuleName]
forall a b. (a -> b) -> a -> b
$ (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModuleName
GHC.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 :: Map ModuleName ModInfo
mod_infos = Map ModuleName ModInfo
newInfos })
SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
Succeeded
SuccessFlag
flag -> SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a. Monad m => a -> m a
return SuccessFlag
flag
resetOptByteCodeIfUnboxed :: GhciMonad m => m ()
resetOptByteCodeIfUnboxed :: forall (m :: Type -> Type). GhciMonad m => m ()
resetOptByteCodeIfUnboxed = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ByteCodeIfUnboxed DynFlags
dflags) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
_ <- 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
$ DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags GeneralFlag
Opt_ByteCodeIfUnboxed
() -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
() -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
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.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket (IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering)
(\()
_ ->
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
SuccessFlag
ok <- m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
m SuccessFlag -> m SuccessFlag
trySuccess (m SuccessFlag -> m SuccessFlag) -> m SuccessFlag -> m SuccessFlag
forall a b. (a -> b) -> a -> b
$ LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
howmuch
SuccessFlag -> Bool -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
SuccessFlag -> Bool -> m ()
afterLoad SuccessFlag
ok Bool
retain_context
SuccessFlag -> m SuccessFlag
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
Bool -> [ModSummary] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [ModSummary] -> m ()
setContextAfterLoad Bool
retain_context [ModSummary]
loaded_mods
setContextAfterLoad :: GhciMonad m => Bool -> [GHC.ModSummary] -> m ()
setContextAfterLoad :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [ModSummary] -> m ()
setContextAfterLoad Bool
keep_ctxt [] = do
Bool -> [InteractiveImport] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [InteractiveImport] -> m ()
setContextKeepingPackageModules Bool
keep_ctxt []
setContextAfterLoad Bool
keep_ctxt [ModSummary]
ms = do
[Target]
targets <- m [Target]
forall (m :: Type -> Type). GhcMonad m => m [Target]
GHC.getTargets
case [ ModSummary
m | Just ModSummary
m <- (Target -> Maybe ModSummary) -> [Target] -> [Maybe ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map ([ModSummary] -> Target -> Maybe ModSummary
findTarget [ModSummary]
ms) [Target]
targets ] of
[] ->
let graph :: ModuleGraph
graph = [ModSummary] -> ModuleGraph
GHC.mkModuleGraph [ModSummary]
ms
graph' :: [ModSummary]
graph' = [SCC ModSummary] -> [ModSummary]
forall a. [SCC a] -> [a]
flattenSCCs (Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
True ModuleGraph
graph Maybe ModuleName
forall a. Maybe a
Nothing)
in ModSummary -> m ()
forall {m :: Type -> Type}. GhciMonad m => ModSummary -> m ()
load_this ([ModSummary] -> ModSummary
forall a. [a] -> a
last [ModSummary]
graph')
(ModSummary
m:[ModSummary]
_) ->
ModSummary -> m ()
forall {m :: Type -> Type}. GhciMonad m => ModSummary -> m ()
load_this ModSummary
m
where
findTarget :: [ModSummary] -> Target -> Maybe ModSummary
findTarget [ModSummary]
mds Target
t
= case (ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModSummary -> Target -> Bool
`matches` Target
t) [ModSummary]
mds of
[] -> Maybe ModSummary
forall a. Maybe a
Nothing
(ModSummary
m:[ModSummary]
_) -> ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
m
ModSummary
summary matches :: ModSummary -> Target -> Bool
`matches` Target (TargetModule ModuleName
m) Bool
_ Maybe (StringBuffer, UTCTime)
_
= ModSummary -> ModuleName
GHC.ms_mod_name ModSummary
summary ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m
ModSummary
summary `matches` Target (TargetFile [Char]
f Maybe Phase
_) Bool
_ Maybe (StringBuffer, UTCTime)
_
| Just [Char]
f' <- ModLocation -> Maybe [Char]
GHC.ml_hs_file (ModSummary -> ModLocation
GHC.ms_location ModSummary
summary) = [Char]
f [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
f'
ModSummary
_ `matches` Target
_
= Bool
False
load_this :: ModSummary -> m ()
load_this ModSummary
summary | Module
m <- ModSummary -> Module
GHC.ms_mod ModSummary
summary = do
Bool
is_interp <- Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
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 (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m)]
| Bool
otherwise = [ModuleName -> InteractiveImport
mkIIDecl (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
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 (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 :: [InteractiveImport]
remembered_ctx = [InteractiveImport]
new_rem_ctx,
transient_ctx :: [InteractiveImport]
transient_ctx = [InteractiveImport] -> [InteractiveImport] -> [InteractiveImport]
filterSubsumed [InteractiveImport]
new_rem_ctx [InteractiveImport]
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 (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
is_pkg_import (IIDecl ImportDecl GhcPs
d)
= do Either SomeException Module
e <- m Module -> m (Either SomeException Module)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try (m Module -> m (Either SomeException Module))
-> m Module -> m (Either SomeException Module)
forall a b. (a -> b) -> a -> b
$ ModuleName -> Maybe FastString -> m Module
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.findModule ModuleName
mod_name ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs (Maybe StringLiteral -> Maybe FastString)
-> Maybe StringLiteral -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
d)
case Either SomeException Module
e :: Either SomeException Module of
Left SomeException
_ -> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
Right Module
m -> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool -> Bool
not (Module -> Bool
isMainUnitModule Module
m))
where
mod_name :: ModuleName
mod_name = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located 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
PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
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)
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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null [ModSummary]
mods = [Char] -> SDoc
text [Char]
"none."
| Bool
otherwise = [SDoc] -> SDoc
hsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
mod_names) SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
"."
SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
status SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
", modules loaded:" SDoc -> SDoc -> SDoc
<+> SDoc
mod_commas
else do
SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
status SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
","
SDoc -> SDoc -> SDoc
<+> Int -> SDoc -> SDoc
speakNOf ([ModSummary] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ModSummary]
mods) ([Char] -> SDoc
text [Char]
"module") SDoc -> SDoc -> SDoc
<+> 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
$
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
unqual SDoc
msg
where
status :: SDoc
status = case SuccessFlag
ok of
SuccessFlag
Failed -> [Char] -> SDoc
text [Char]
"Failed"
SuccessFlag
Succeeded -> [Char] -> SDoc
text [Char]
"Ok"
mod_name :: ModSummary -> m SDoc
mod_name ModSummary
mod = do
Bool
is_interpreted <- ModSummary -> m Bool
forall {f :: Type -> Type}. GhcMonad f => ModSummary -> f Bool
GHC.moduleIsBootOrNotObjectLinkable ModSummary
mod
SDoc -> m SDoc
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ if Bool
is_interpreted
then Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> Module
GHC.ms_mod ModSummary
mod)
else Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> Module
GHC.ms_mod ModSummary
mod)
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([Char] -> SDoc
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)
runExceptGhcMonad :: GHC.GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad :: forall (m :: Type -> Type). GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad 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). GhcMonad 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}.
(HasDynFlags m, MonadIO m) =>
SDoc -> m ()
handleErr () -> m ()
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
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SDoc -> IO ()) -> SDoc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> (SDoc -> [Char]) -> SDoc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
alwaysQualify (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ SDoc
sdoc
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 (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 ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
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 (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 = Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
False ModuleGraph
modGraph Maybe ModuleName
forall a. Maybe a
Nothing
[[Char]] -> InputT GHCi [[Char]]
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]] -> m ()
go [[Char]]
srcs = do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
DynFlags -> [[Char]] -> m ()
forall {m :: Type -> Type}.
GhciMonad m =>
DynFlags -> [[Char]] -> m ()
goX DynFlags
dflags [[Char]]
srcs m () -> m () -> m ()
forall (m :: Type -> Type) a b. MonadMask m => m a -> m b -> m a
`MC.finally` DynFlags -> m ()
forall {m :: Type -> Type}. GhciMonad m => DynFlags -> m ()
recover DynFlags
dflags
goX :: DynFlags -> [[Char]] -> m ()
goX DynFlags
dflags [[Char]]
srcs = do
(DynFlags
dflagsX,[Located [Char]]
_,[Warn]
_) <- DynFlags
-> [Located [Char]] -> m (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 -> GenLocated SrcSpan e
noLoc [Char]
"-fobject-code"
, [Char] -> Located [Char]
forall {e}. e -> GenLocated SrcSpan e
noLoc [Char]
"-fforce-recomp"
, [Char] -> Located [Char]
forall {e}. e -> GenLocated SrcSpan e
noLoc [Char]
"-keep-tmp-files"
]
()
_ <- DynFlags -> m ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflagsX
[Char] -> m ()
forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
reloadModule [Char]
""
HscEnv
env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> [Linkable] -> IO ()
unload HscEnv
env [])
Proxy backend -> Ghc () -> IORef ClashOpts -> [[Char]] -> m ()
forall backend (m :: Type -> Type).
(GhcMonad m, Backend backend) =>
Proxy backend -> Ghc () -> IORef ClashOpts -> [[Char]] -> m ()
makeHDL Proxy backend
backend (() -> Ghc ()
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). 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 (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 :: OverridingBool
opt_color = DynFlags -> OverridingBool
useColor DynFlags
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 [Char]
opt_hdlDir = Maybe [Char]
-> ([Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [Char]
outputDir [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (ClashOpts -> Maybe [Char]
opt_hdlDir ClashOpts
opts1)
, opt_importPaths :: [[Char]]
opt_importPaths = [[Char]]
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)
traverse [Char] -> IO (TopEntityT, [TopEntityT])
getMain (DynFlags -> Maybe [Char]
GHC.mainFunIs DynFlags
dflags)
UTCTime
prepTime <- UTCTime
startTime UTCTime -> BindingMap -> BindingMap
forall a b. NFData a => a -> b -> b
`deepseq` ClashDesign -> BindingMap
designBindings ClashDesign
clashDesign BindingMap -> TyConMap -> TyConMap
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 :: GHC.GhcMonad m => String -> m ()
typeOfExpr :: forall (m :: Type -> Type). GhcMonad 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). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let (TcRnExprMode
mode, [Char]
expr_str) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
str of
([Char]
"+d", [Char]
rest) -> (TcRnExprMode
GHC.TM_Default, (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
([Char]
"+v", [Char]
rest) -> (TcRnExprMode
GHC.TM_NoInst, (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest)
([Char], [Char])
_ -> (TcRnExprMode
GHC.TM_Inst, [Char]
str)
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
sep [[Char] -> SDoc
text [Char]
expr_str, Int -> SDoc -> SDoc
nest Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser 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). GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad (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 (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 (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
sep [[Char] -> SDoc
text [Char]
sample,Int -> SDoc -> SDoc
nest Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> 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). GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad (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 (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 (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). GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad (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 (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 (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). GhcMonad m => ExceptT SDoc m () -> m ()
runExceptGhcMonad (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 (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 (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}.
(HasDynFlags m, MonadIO m) =>
SpanInfo -> m ()
printSpan)
where
printSpan :: SpanInfo -> m ()
printSpan SpanInfo
span'
| Just Type
ty <- SpanInfo -> Maybe Type
spaninfoType SpanInfo
span' = do
DynFlags
df <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
let tyInfo :: [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]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
df PrintUnqualified
alwaysQualify (Type -> SDoc
pprTypeForUser Type
ty)
IO () -> m ()
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 (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 (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
<+> [Char] -> SDoc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0) SDoc -> SDoc -> SDoc
<+> 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])
forall {b}. Either SDoc b
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])
forall {b}. Either SDoc b
leftRes
where
leftRes :: Either SDoc b
leftRes = SDoc -> Either SDoc b
forall a b. a -> Either a b
Left (SDoc
"Couldn't read" SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0) SDoc -> SDoc -> SDoc
<+> 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
<+> [Char] -> SDoc
text ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s0))
isWs :: Char -> Bool
isWs = (Char -> [Char] -> 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 :: GHC.GhcMonad m => Bool -> String -> m ()
kindOfType :: forall (m :: Type -> Type). GhcMonad 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). GhcMonad m => SourceError -> m ()
GHC.printException (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
vcat [ [Char] -> SDoc
text [Char]
str SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
kind
, Bool -> SDoc -> SDoc
ppWhen Bool
norm (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
equals SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
ty ]
quit :: Monad m => String -> m Bool
quit :: forall (m :: Type -> Type). Monad m => [Char] -> m Bool
quit [Char]
_ = Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
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 (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 :: [Char]
progname=[Char]
filename',line_number :: Int
line_number=Int
0}
Handle -> InputT GHCi ()
scriptLoop Handle
script
IO () -> InputT GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT GHCi ()) -> IO () -> InputT GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> 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 :: [Char]
progname=[Char]
prog,line_number :: Int
line_number=Int
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 (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 (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
Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
lookupModule [Char]
s
Module -> m ()
forall (m :: Type -> Type). GhcMonad m => Module -> m ()
isSafeModule Module
md
[] -> do Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
guessCurrentModule [Char]
"issafe"
Module -> m ()
forall (m :: Type -> Type). GhcMonad m => Module -> m ()
isSafeModule Module
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 => Module -> m ()
isSafeModule Module
m = do
Maybe ModuleInfo
mb_mod_info <- Module -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo Module
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
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
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m))
(Bool
msafe, Set UnitId
pkgs) <- Module -> m (Bool, Set UnitId)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Bool, Set UnitId)
GHC.moduleTrustReqs Module
m
let trust :: [Char]
trust = DynFlags -> SafeHaskellMode -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
showPpr DynFlags
dflags (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 DynFlags -> Module -> Bool
packageTrusted DynFlags
dflags Module
m then [Char]
"trusted" else [Char]
"untrusted"
(Set UnitId
good, Set UnitId
bad) = DynFlags -> Set UnitId -> (Set UnitId, Set UnitId)
tallyPkgs DynFlags
dflags Set UnitId
pkgs
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> 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 (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 (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 (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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null Set UnitId
bad)
(IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> 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 (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
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m
packageTrusted :: DynFlags -> Module -> Bool
packageTrusted DynFlags
dflags Module
md
| DynFlags -> Module -> Bool
isHomeModule DynFlags
dflags Module
md = Bool
True
| Bool
otherwise = GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsTrusted (GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool)
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack =>
UnitState
-> Unit
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
UnitState
-> Unit
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
unsafeLookupUnit (DynFlags -> UnitState
unitState DynFlags
dflags) (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
md)
tallyPkgs :: DynFlags -> Set UnitId -> (Set UnitId, Set UnitId)
tallyPkgs DynFlags
dflags 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
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsTrusted (GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool)
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
-> Bool
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack =>
UnitState
-> UnitId
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
UnitState
-> UnitId
-> GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
unsafeLookupUnitId UnitState
pkgstate UnitId
pkg
pkgstate :: UnitState
pkgstate = DynFlags -> UnitState
unitState DynFlags
dflags
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
Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
wantInterpretedModule [Char]
s
Bool -> Module -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Module -> Bool -> m ()
browseModule Bool
bang Module
md Bool
False
[[Char]
s] | [Char] -> Bool
looksLikeModuleName [Char]
s -> do
Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
lookupModule [Char]
s
Bool -> Module -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Module -> Bool -> m ()
browseModule Bool
bang Module
md Bool
True
[] -> do Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
guessCurrentModule ([Char]
"browse" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
bang then [Char]
"!" else [Char]
"")
Bool -> Module -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Module -> Bool -> m ()
browseModule Bool
bang Module
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 Module
guessCurrentModule [Char]
cmd
= do [InteractiveImport]
imports <- m [InteractiveImport]
forall (m :: Type -> Type). GhcMonad m => m [InteractiveImport]
GHC.getContext
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when ([InteractiveImport] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [InteractiveImport]
imports) (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
CmdLineError (Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cmd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": no current module")
case ([InteractiveImport] -> InteractiveImport
forall a. [a] -> a
head [InteractiveImport]
imports) of
IIModule ModuleName
m -> ModuleName -> Maybe FastString -> m Module
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.findModule ModuleName
m Maybe FastString
forall a. Maybe a
Nothing
IIDecl ImportDecl GhcPs
d -> ModuleName -> Maybe FastString -> m Module
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.findModule (Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
d))
((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs (Maybe StringLiteral -> Maybe FastString)
-> Maybe StringLiteral -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
d)
browseModule :: GHC.GhcMonad m => Bool -> Module -> Bool -> m ()
browseModule :: forall (m :: Type -> Type).
GhcMonad m =>
Bool -> Module -> Bool -> m ()
browseModule Bool
bang Module
modl Bool
exports_only = do
PrintUnqualified
unqual <- m PrintUnqualified
forall (m :: Type -> Type). GhcMonad m => m PrintUnqualified
GHC.getPrintUnqual
Maybe ModuleInfo
mb_mod_info <- Module -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo Module
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 (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
modl)))
Just ModuleInfo
mod_info -> do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
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) = ASSERT( all isExternalName names )
(Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
==Module
modl) (Module -> Bool) -> (Name -> Module) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> Module
Name -> Module
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)
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]] -> SDoc
labels [] = [Char] -> SDoc
text [Char]
"-- not currently imported"
labels [Maybe [ModuleName]]
l = [Char] -> SDoc
text ([Char] -> SDoc) -> [Char] -> SDoc
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]], SDoc)] -> [SDoc]
annotate [([Maybe [ModuleName]], SDoc)]
mts = (([Maybe [ModuleName]], [SDoc]) -> [SDoc])
-> [([Maybe [ModuleName]], [SDoc])] -> [SDoc]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\([Maybe [ModuleName]]
m,[SDoc]
ts)->[Maybe [ModuleName]] -> SDoc
labels [Maybe [ModuleName]]
mSDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
:[SDoc]
ts)
([([Maybe [ModuleName]], [SDoc])] -> [SDoc])
-> [([Maybe [ModuleName]], [SDoc])] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (([Maybe [ModuleName]], [SDoc])
-> ([Maybe [ModuleName]], [SDoc]) -> Ordering)
-> [([Maybe [ModuleName]], [SDoc])]
-> [([Maybe [ModuleName]], [SDoc])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([Maybe [ModuleName]], [SDoc])
-> ([Maybe [ModuleName]], [SDoc]) -> Ordering
forall {b}.
([Maybe [ModuleName]], b) -> ([Maybe [ModuleName]], b) -> Ordering
cmpQualifiers ([([Maybe [ModuleName]], [SDoc])]
-> [([Maybe [ModuleName]], [SDoc])])
-> [([Maybe [ModuleName]], [SDoc])]
-> [([Maybe [ModuleName]], [SDoc])]
forall a b. (a -> b) -> a -> b
$ [([Maybe [ModuleName]], SDoc)] -> [([Maybe [ModuleName]], [SDoc])]
forall {a} {b}. Eq a => [(a, b)] -> [(a, [b])]
grp [([Maybe [ModuleName]], SDoc)]
mts
where cmpQualifiers :: ([Maybe [ModuleName]], b) -> ([Maybe [ModuleName]], b) -> Ordering
cmpQualifiers =
[Maybe [FastString]] -> [Maybe [FastString]] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Maybe [FastString]] -> [Maybe [FastString]] -> Ordering)
-> (([Maybe [ModuleName]], b) -> [Maybe [FastString]])
-> ([Maybe [ModuleName]], b)
-> ([Maybe [ModuleName]], b)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Maybe [ModuleName] -> Maybe [FastString])
-> [Maybe [ModuleName]] -> [Maybe [FastString]]
forall a b. (a -> b) -> [a] -> [b]
map (([ModuleName] -> [FastString])
-> Maybe [ModuleName] -> Maybe [FastString]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModuleName -> FastString) -> [ModuleName] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FastString
moduleNameFS)) ([Maybe [ModuleName]] -> [Maybe [FastString]])
-> (([Maybe [ModuleName]], b) -> [Maybe [ModuleName]])
-> ([Maybe [ModuleName]], b)
-> [Maybe [FastString]]
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]
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
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> PrintUnqualified -> SDoc -> [Char]
showSDocForUser DynFlags
dflags PrintUnqualified
unqual ([SDoc] -> SDoc
vcat [SDoc]
prettyThings')
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 <- Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> m Module -> m ModuleName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
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 :: [InteractiveImport]
remembered_ctx = [InteractiveImport] -> [InteractiveImport]
filt (GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st)
, transient_ctx :: [InteractiveImport]
transient_ctx = [InteractiveImport] -> [InteractiveImport]
filt (GHCiState -> [InteractiveImport]
transient_ctx GHCiState
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 :: [InteractiveImport]
remembered_ctx = [], transient_ctx :: [InteractiveImport]
transient_ctx = [] }
[ModuleName] -> [ModuleName] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> [ModuleName] -> m ()
addModulesToContext_ [ModuleName]
starred [ModuleName]
unstarred
addImportToContext :: GhciMonad m => String -> m ()
addImportToContext :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
addImportToContext [Char]
str = 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
ImportDecl GhcPs
idecl <- [Char] -> m (ImportDecl GhcPs)
forall (m :: Type -> Type).
GhcMonad m =>
[Char] -> m (ImportDecl GhcPs)
GHC.parseImportDecl [Char]
str
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 :: [InteractiveImport]
remembered_ctx = InteractiveImport -> [InteractiveImport] -> [InteractiveImport]
addNotSubsumed InteractiveImport
iidecl (GHCiState -> [InteractiveImport]
remembered_ctx GHCiState
st)
, transient_ctx :: [InteractiveImport]
transient_ctx = (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
iidecl InteractiveImport -> InteractiveImport -> Bool
`iiSubsumes`))
(GHCiState -> [InteractiveImport]
transient_ctx GHCiState
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. 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 :: [InteractiveImport]
remembered_ctx = [InteractiveImport]
rc, transient_ctx :: [InteractiveImport]
transient_ctx = [InteractiveImport]
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 Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName ModuleName
modname m Module -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
IIDecl ImportDecl GhcPs
d -> do
let modname :: ModuleName
modname = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
d)
pkgqual :: Maybe StringLiteral
pkgqual = ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
d
Module
m <- ModuleName -> Maybe FastString -> m Module
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.lookupModule ModuleName
modname ((StringLiteral -> FastString)
-> Maybe StringLiteral -> Maybe FastString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> FastString
sl_fs Maybe StringLiteral
pkgqual)
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 <- Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.isModuleTrusted Module
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 (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
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
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) = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located 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) = Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
d) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located 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)
= Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
d1) ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Located ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
d2)
Bool -> Bool -> Bool
&& ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl GhcPs
d1 Maybe (Located ModuleName) -> Maybe (Located ModuleName) -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located 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 (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
d1 Maybe (Bool, Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall {a} {l}.
(Eq a, Eq l) =>
Maybe (Bool, GenLocated l [a])
-> Maybe (Bool, GenLocated l [a]) -> Bool
`hidingSubsumes` ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
d2)
where
Maybe (Bool, GenLocated l [a])
_ hidingSubsumes :: Maybe (Bool, GenLocated l [a])
-> Maybe (Bool, GenLocated l [a]) -> Bool
`hidingSubsumes` Just (Bool
False,L l
_ []) = Bool
True
Just (Bool
False, L l
_ [a]
xs) `hidingSubsumes` Just (Bool
False,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 (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [a]
xs) [a]
ys
Maybe (Bool, GenLocated l [a])
h1 `hidingSubsumes` Maybe (Bool, GenLocated l [a])
h2 = Maybe (Bool, GenLocated l [a])
h1 Maybe (Bool, GenLocated l [a])
-> Maybe (Bool, GenLocated l [a]) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Bool, 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]]
toArgs [Char]
rest of
Left [Char]
err -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
args -> [[Char]] -> m ()
forall (m :: Type -> Type). GhciMonad m => [[Char]] -> m ()
setArgs [[Char]]
args
Right ([Char]
"prog", [Char]
rest) ->
case [Char] -> Either [Char] [[Char]]
toArgs [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 (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]]
toArgs [Char]
str of
Left [Char]
err -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
wds -> [[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 (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
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 (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
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]]
toArgs [Char]
str of
Left [Char]
err -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err)
Right [[Char]]
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 (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
text [Char]
"options currently set: " SDoc -> SDoc -> SDoc
<>
if [GHCiOption] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [GHCiOption]
opts
then [Char] -> SDoc
text [Char]
"none."
else [SDoc] -> SDoc
hsep ((GHCiOption -> SDoc) -> [GHCiOption] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\GHCiOption
o -> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text (GHCiOption -> [Char]
optToStr GHCiOption
o)) [GHCiOption]
opts)
))
m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags m DynFlags -> (DynFlags -> m ()) -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
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
show_all
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
text [Char]
"GHCi-specific dynamic flag settings:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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
text [Char]
"other dynamic, non-language, flag settings:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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
text [Char]
"warning settings:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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 :: [Char]
-> [Char] -> (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting [Char]
prefix [Char]
noPrefix flag -> DynFlags -> Bool
test FlagSpec flag
flag
| Bool
quiet = SDoc
empty
| Bool
is_on = [Char] -> SDoc
text [Char]
prefix SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
name
| Bool
otherwise = [Char] -> SDoc
text [Char]
noPrefix SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
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 -> LlvmConfig -> DynFlags
defaultDynFlags (DynFlags -> Settings
settings DynFlags
dflags) (DynFlags -> LlvmConfig
llvmConfig 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 (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 { args :: [[Char]]
GhciMonad.args = [[Char]]
args, evalWrapper :: ForeignHValue
evalWrapper = ForeignHValue
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 :: [Char]
progname = [Char]
prog, evalWrapper :: ForeignHValue
evalWrapper = ForeignHValue
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 :: [Char]
editor = [Char]
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 :: LocalConfigBehaviour
localConfig = LocalConfigBehaviour
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 :: LocalConfigBehaviour
localConfig = LocalConfigBehaviour
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
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nm SDoc -> SDoc -> SDoc
<+>
[Char] -> SDoc
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 :: [Char]
onBreakCmd = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
rest }
IntMap BreakLocation
old_breaks
GHCiState -> m ()
forall (m :: Type -> Type). GhciMonad m => GHCiState -> m ()
setGHCiState GHCiState
st{ breaks :: IntMap BreakLocation
breaks = IntMap BreakLocation
new_breaks }
setStop [Char]
cmd = (GHCiState -> GHCiState) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
(GHCiState -> GHCiState) -> m ()
modifyGHCiState (\GHCiState
st -> GHCiState
st { stop :: [Char]
stop = [Char]
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 :: PromptFunction
prompt = PromptFunction
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 :: PromptFunction
prompt_cont = PromptFunction
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 (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
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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
value
then IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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 (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 (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 (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 -> GenLocated SrcSpan e
noLoc [[Char]]
minus_opts
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])
GHC.parseDynamicFlags DynFlags
idflags0 [Located [Char]]
lopts
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> [Warn] -> IO ()
handleFlagWarnings 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 (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 (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"
HscEnv
hsc_env0 <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
DynFlags
idflags2 <- IO DynFlags -> m DynFlags
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> DynFlags -> IO DynFlags
initializePlugins HscEnv
hsc_env0 DynFlags
idflags1)
DynFlags -> m ()
forall (m :: Type -> Type). GhcMonad m => DynFlags -> m ()
GHC.setInteractiveDynFlags DynFlags
idflags2
Maybe [Char] -> Bool -> m ()
forall (m :: Type -> Type).
GhcMonad 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 (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])
GHC.parseDynamicFlags 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
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 (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 ()
clearAllTargets
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 (DynFlags -> UnitState
unitState DynFlags
dflags2)
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> [UnitId] -> IO ()
linkPackages HscEnv
hsc_env [UnitId]
units
Bool -> [ModSummary] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [ModSummary] -> m ()
setContextAfterLoad Bool
False []
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{ unitState :: UnitState
unitState = DynFlags -> UnitState
unitState DynFlags
dflags2
, unitDatabases :: Maybe [UnitDatabase UnitId]
unitDatabases = DynFlags -> Maybe [UnitDatabase UnitId]
unitDatabases DynFlags
dflags2
, packageFlags :: [PackageFlag]
packageFlags = DynFlags -> [PackageFlag]
packageFlags DynFlags
dflags2 }
let ld0length :: Int
ld0length = [Option] -> 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 (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)
hsc_env' :: HscEnv
hsc_env' = HscEnv
hsc_env { hsc_dflags :: DynFlags
hsc_dflags =
DynFlags
dflags2 { ldInputs :: [Option]
ldInputs = [Option]
newLdInputs
, cmdlineFrameworks :: [[Char]]
cmdlineFrameworks = [[Char]]
newCLFrameworks } }
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Option] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Option]
newLdInputs Bool -> Bool -> Bool
&& [[Char]] -> 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 (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO ()
linkCmdLineLibs HscEnv
hsc_env'
() -> m ()
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 (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 (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO [Char]
findEditor m [Char] -> ([Char] -> m ()) -> m ()
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 (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 (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 if (Bool -> Bool
not ([[Char]] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
rest3))
then IO () -> m ()
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]] -> [Char]
forall a. [a] -> a
head [[Char]]
rest3 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"))
else 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)
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 (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 (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 (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 (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 (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 (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 (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 (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
$ DynLinker -> IO SDoc
showLinkerState (HscEnv -> DynLinker
hsc_dynLinker HscEnv
hsc_env)
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogAction
putLogMsg DynFlags
dflags WarnReason
NoReason Severity
SevDump SrcSpan
noSrcSpan 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
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
text [Char]
"syntax:") Int
4
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Char] -> SDoc
text [Char]
":show") Int
6
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
brackets ([SDoc] -> SDoc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate ([Char] -> SDoc
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 (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 (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 (ModuleName -> m Bool
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Bool
GHC.isLoaded (ModuleName -> m Bool)
-> (ModSummary -> ModuleName) -> ModSummary -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModuleName
GHC.ms_mod_name) (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)
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 (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
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
$$ SDoc
show_fixity
where
show_fixity :: SDoc
show_fixity
| Fixity
fixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
GHC.defaultFixity = SDoc
empty
| Bool
otherwise = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyThing -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyThing
thing)
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)
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
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 =
PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"--> ") SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text (Resume -> [Char]
GHC.resumeStmt Resume
res)
SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (Resume -> SDoc
pprStopped Resume
res)
pprStopped :: GHC.Resume -> SDoc
pprStopped :: Resume -> SDoc
pprStopped Resume
res =
PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"Stopped in")
SDoc -> SDoc -> SDoc
<+> ((case Maybe ModuleName
mb_mod_name of
Maybe ModuleName
Nothing -> SDoc
empty
Just ModuleName
mod_name -> [Char] -> SDoc
text (ModuleName -> [Char]
moduleNameString ModuleName
mod_name) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.')
SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text (Resume -> [Char]
GHC.resumeDecl Resume
res))
SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
',' SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Resume -> SrcSpan
GHC.resumeSpan Resume
res)
where
mb_mod_name :: Maybe ModuleName
mb_mod_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName)
-> (BreakInfo -> Module) -> BreakInfo -> ModuleName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BreakInfo -> Module
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 (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
text ([Char]
"active package flags:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++if [PackageFlag] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [PackageFlag]
pkg_flags then [Char]
" none" else [Char]
"") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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 (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
text [Char]
"current working directory: " SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([Char] -> SDoc
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
text ([Char]
"module import search paths:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++if [[Char]] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
ipaths then [Char]
" none" else [Char]
"") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat (([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
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 (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
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 (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
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
vcat
[ [Char] -> SDoc
text [Char]
"base language is: " SDoc -> SDoc -> SDoc
<>
case DynFlags -> Maybe Language
language DynFlags
dflags of
Maybe Language
Nothing -> [Char] -> SDoc
text [Char]
"Haskell2010"
Just Language
Haskell98 -> [Char] -> SDoc
text [Char]
"Haskell98"
Just Language
Haskell2010 -> [Char] -> SDoc
text [Char]
"Haskell2010"
, (if Bool
show_all then [Char] -> SDoc
text [Char]
"all active language options:"
else [Char] -> SDoc
text [Char]
"with the following modifiers:") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat ((FlagSpec Extension -> SDoc) -> [FlagSpec Extension] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((Extension -> DynFlags -> Bool) -> FlagSpec Extension -> SDoc
forall {flag}. (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting Extension -> DynFlags -> Bool
xopt) [FlagSpec Extension]
DynFlags.xFlags))
]
where
setting :: (flag -> DynFlags -> Bool) -> FlagSpec flag -> SDoc
setting flag -> DynFlags -> Bool
test FlagSpec flag
flag
| Bool
quiet = SDoc
empty
| Bool
is_on = [Char] -> SDoc
text [Char]
"-X" SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
name
| Bool
otherwise = [Char] -> SDoc
text [Char]
"-XNo" SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
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 -> LlvmConfig -> DynFlags
defaultDynFlags (DynFlags -> Settings
settings DynFlags
dflags) (DynFlags -> LlvmConfig
llvmConfig DynFlags
dflags) DynFlags -> Maybe Language -> DynFlags
`lang_set`
case DynFlags -> Maybe Language
language DynFlags
dflags of
Maybe Language
Nothing -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
Haskell2010
Maybe Language
other -> Maybe Language
other
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 (TargetFile [Char]
f Maybe Phase
_) Bool
_ Maybe (StringBuffer, UTCTime)
_) = IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
putStrLn [Char]
f)
showTarget (Target (TargetModule ModuleName
m) Bool
_ Maybe (StringBuffer, UTCTime)
_) =
IO () -> m ()
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 (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 (t :: Type -> Type) a. Foldable t => t a -> Int
length [Completion]
compls'), Int -> [Char]
forall a. Show a => a -> [Char]
show ([Completion] -> 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 (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 [Char]
argLine
| [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
argLine = Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a. Maybe a
Nothing
| [Char] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
rest1 = Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall a. Maybe a
Nothing
| Bool
otherwise = (,,) [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
<$> Maybe (Maybe Int, Maybe Int)
resRange Maybe ([Char] -> ([Char], (Maybe Int, Maybe Int), [Char]))
-> Maybe [Char] -> Maybe ([Char], (Maybe Int, Maybe Int), [Char])
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe [Char]
s
where
([Char]
dom, [Char]
rest1) = [Char] -> ([Char], [Char])
breakSpace [Char]
argLine
([Char]
rng, [Char]
rest2) = [Char] -> ([Char], [Char])
breakSpace [Char]
rest1
resRange :: Maybe (Maybe Int, Maybe Int)
resRange | [Char] -> Char
forall a. [a] -> a
head [Char]
rest1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = [Char] -> Maybe (Maybe Int, Maybe Int)
parseRange [Char]
""
| Bool
otherwise = [Char] -> Maybe (Maybe Int, Maybe Int)
parseRange [Char]
rng
s :: Maybe [Char]
s | [Char] -> Char
forall a. [a] -> a
head [Char]
rest1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = [Char] -> Maybe [Char]
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
rest1 :: Maybe String
| Bool
otherwise = [Char] -> Maybe [Char]
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
rest2
breakSpace :: [Char] -> ([Char], [Char])
breakSpace = ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
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 (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 (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 (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 (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 (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 (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 (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 (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
x:[Char]
_) | Char -> Bool
isSymbolChar Char
x -> [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]
_ -> ([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 (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 (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
[Module]
imods <- m [Module]
forall (m :: Type -> Type). GhciMonad m => m [Module]
interpretedHomeMods
let pmods :: [Module]
pmods = (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
mod_pref) ([Char] -> Bool) -> (Module -> [Char]) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Char]
showModule) [Module]
imods
[ModuleName]
nonquals <- case [Char] -> 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 (f :: Type -> Type) a. Applicative f => a -> f a
pure [ ModuleName
m | IIModule ModuleName
m <- [InteractiveImport]
imports]
Bool
False -> [ModuleName] -> m [ModuleName]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
[[[Char]]]
bidss <- (Module -> m [[Char]]) -> [Module] -> m [[[Char]]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ModuleName] -> Module -> m [[Char]]
forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> Module -> m [[Char]]
bidsByModule [ModuleName]
nonquals) [Module]
pmods
[[Char]] -> m [[Char]]
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 [Module]
interpretedHomeMods = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let hmods :: [Module]
hmods = ModSummary -> Module
ms_mod (ModSummary -> Module) -> [ModSummary] -> [Module]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph
(Module -> m Bool) -> [Module] -> m [Module]
forall (m :: Type -> Type) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted [Module]
hmods
bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String]
bidsByModule :: forall (m :: Type -> Type).
GhciMonad m =>
[ModuleName] -> Module -> m [[Char]]
bidsByModule [ModuleName]
nonquals Module
mod = do
(ForeignRef BreakArray
_, Array Int SrcSpan
_, Array Int [[Char]]
decls) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
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 (f :: Type -> Type) a. Applicative f => a -> f a
pure ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ case (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) ModuleName -> [ModuleName] -> 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 (Module -> [Char]
showModule Module
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
[RdrName]
rdrs <- m [RdrName]
forall (m :: Type -> Type). GhcMonad m => m [RdrName]
GHC.getRdrNamesInScope
[[([Char], Module)]]
inscopess <- ([Char] -> m [([Char], Module)])
-> [[Char]] -> m [[([Char], Module)]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> m [([Char], Module)]
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m [([Char], Module)]
createInscope ([[Char]] -> m [[([Char], Module)]])
-> [[Char]] -> m [[([Char], Module)]]
forall a b. (a -> b) -> a -> b
$ (SDoc -> [Char]
showSDocUnsafe (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
[Module]
imods <- m [Module]
forall (m :: Type -> Type). GhciMonad m => m [Module]
interpretedHomeMods
let topLevels :: [([Char], Module)]
topLevels = (([Char], Module) -> Bool)
-> [([Char], Module)] -> [([Char], Module)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Module -> [Module] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Module]
imods) (Module -> Bool)
-> (([Char], Module) -> Module) -> ([Char], Module) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Module) -> Module
forall a b. (a, b) -> b
snd) ([([Char], Module)] -> [([Char], Module)])
-> [([Char], Module)] -> [([Char], Module)]
forall a b. (a -> b) -> a -> b
$ [[([Char], Module)]] -> [([Char], Module)]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[([Char], Module)]]
inscopess
[[[Char]]]
bidss <- (([Char], Module) -> m [[Char]])
-> [([Char], Module)] -> m [[[Char]]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Char], Module) -> m [[Char]]
forall (m :: Type -> Type).
GhciMonad m =>
([Char], Module) -> m [[Char]]
addNestedDecls) [([Char], Module)]
topLevels
[[Char]] -> m [[Char]]
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], Module)]
createInscope [Char]
str_rdr = do
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
str_rdr
[([Char], Module)] -> m [([Char], Module)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([([Char], Module)] -> m [([Char], Module)])
-> [([Char], Module)] -> m [([Char], Module)]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Module] -> [([Char], Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Char] -> [[Char]]
forall a. a -> [a]
repeat [Char]
str_rdr) ([Module] -> [([Char], Module)]) -> [Module] -> [([Char], Module)]
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
Name -> Module
GHC.nameModule (Name -> Module) -> [Name] -> [Module]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names
addNestedDecls :: GhciMonad m => (String, Module) -> m [String]
addNestedDecls :: forall (m :: Type -> Type).
GhciMonad m =>
([Char], Module) -> m [[Char]]
addNestedDecls ([Char]
ident, Module
mod) = do
(ForeignRef BreakArray
_, Array Int SrcSpan
_, Array Int [[Char]]
decls) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
mod
let ([Char]
mod_str, [Char]
topLvl, [Char]
_) = [Char] -> ([Char], [Char], [Char])
splitIdent [Char]
ident
ident_decls :: [[[Char]]]
ident_decls = ([[Char]] -> Bool) -> [[[Char]]] -> [[[Char]]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char]
topLvl [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Char] -> Bool) -> ([[Char]] -> [Char]) -> [[Char]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. [a] -> a
head) ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ Array Int [[Char]] -> [[[Char]]]
forall i e. Array i e -> [e]
elems Array Int [[Char]]
decls
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 (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
wrapIdentCompleter (([Char] -> m [[Char]]) -> CompletionFunc m)
-> ([Char] -> m [[Char]]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \[Char]
w -> do
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
let pkg_mods :: [ModuleName]
pkg_mods = DynFlags -> [ModuleName]
allVisibleModules DynFlags
dflags
[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 (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 DynFlags
dflags) ([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
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
[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 (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 = DynFlags -> [ModuleName]
allVisibleModules DynFlags
dflags
[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 (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 (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 DynFlags
dflags) [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
wrapIdentCompleter [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 (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 (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 = ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
forall a. [a] -> a
head ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[[Char]]]
forall a. Eq a => [a] -> [[a]]
group ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[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 (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 = ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
forall a. [a] -> a
head ([[[Char]]] -> [[Char]]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[[Char]]]
forall a. Eq a => [a] -> [[a]]
group ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[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 (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 (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 (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 (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] -> m [[Char]]
fun = 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]
breakChars
(([Char] -> m [Completion]) -> CompletionFunc m)
-> ([Char] -> m [Completion]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [Completion]) -> m [[Char]] -> m [Completion]
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] -> ([Char] -> m [[Char]]) -> CompletionFunc m
forall (m :: Type -> Type).
Monad m =>
[Char] -> ([Char] -> m [[Char]]) -> CompletionFunc m
wrapCompleter [Char]
word_break_chars
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 (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 (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char]
modifChars)
allVisibleModules :: DynFlags -> [ModuleName]
allVisibleModules :: DynFlags -> [ModuleName]
allVisibleModules DynFlags
dflags = UnitState -> [ModuleName]
listVisibleModuleNames (DynFlags -> UnitState
unitState DynFlags
dflags)
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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
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 (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 (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
Module
md <- Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Module
forall a. [Char] -> a
panic [Char]
"stepLocalCmd") (Maybe Module -> Module) -> m (Maybe Module) -> m Module
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe Module)
forall (m :: Type -> Type). GhcMonad m => m (Maybe Module)
getCurrentBreakModule
RealSrcSpan
current_toplevel_decl <- Module -> SrcSpan -> m RealSrcSpan
forall (m :: Type -> Type).
GhciMonad m =>
Module -> SrcSpan -> m RealSrcSpan
enclosingTickSpan Module
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
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 (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 =>
Module -> SrcSpan -> m RealSrcSpan
enclosingTickSpan Module
_ (UnhelpfulSpan UnhelpfulSpanReason
_) = [Char] -> m RealSrcSpan
forall a. [Char] -> a
panic [Char]
"enclosingTickSpan UnhelpfulSpan"
enclosingTickSpan Module
md (RealSrcSpan RealSrcSpan
src Maybe BufSpan
_) = do
TickArray
ticks <- Module -> m TickArray
forall (m :: Type -> Type). GhciMonad m => Module -> m TickArray
getTickArray Module
md
let line :: Int
line = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
src
ASSERT(inRange (bounds ticks) line) do
let enclosing_spans = [ pan | (_,pan) <- ticks ! line
, realSrcSpanEnd pan >= realSrcSpanEnd src]
return . head . sortBy leftmostLargestRealSrcSpan $ enclosing_spans
where
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
leftmostLargestRealSrcSpan RealSrcSpan
a RealSrcSpan
b =
(RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
a RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
b)
Ordering -> Ordering -> Ordering
`thenCmp`
(RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
b RealSrcLoc -> RealSrcLoc -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
a)
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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
continueCmd :: GhciMonad m => String -> m ()
continueCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
continueCmd = 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]
":continue" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (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.RunToCompletion
doContinue :: GhciMonad m => (SrcSpan -> Bool) -> SingleStep -> m ()
doContinue :: forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ()
doContinue SrcSpan -> Bool
pre SingleStep
step = do
ExecResult
runResult <- (SrcSpan -> Bool) -> SingleStep -> m ExecResult
forall (m :: Type -> Type).
GhciMonad m =>
(SrcSpan -> Bool) -> SingleStep -> m ExecResult
resume SrcSpan -> Bool
pre SingleStep
step
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 (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 (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 (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 (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
text [Char]
"The" SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
strCmd SDoc -> SDoc -> SDoc
<+>
[Char] -> SDoc
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)
getBreakLoc 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)
getBreakLoc :: GhciMonad m => Bool -> String -> m (Either SDoc BreakLocation)
getBreakLoc :: forall (m :: Type -> Type).
GhciMonad m =>
Bool -> [Char] -> m (Either SDoc BreakLocation)
getBreakLoc Bool
enaDisa [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 (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 (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
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
strId SDoc -> SDoc -> SDoc
<+>
[Char] -> SDoc
text [Char]
"not found")
Just BreakLocation
loc ->
if BreakLocation -> Bool
breakEnabled BreakLocation
loc Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
enaDisa
then Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
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
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
strId SDoc -> SDoc -> SDoc
<+>
[Char] -> SDoc
text [Char]
"already in desired state")
else Either SDoc BreakLocation -> m (Either SDoc BreakLocation)
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
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).
GhcMonad 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 :: IntMap BreakLocation
breaks = IntMap BreakLocation
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 (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 (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 (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 (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)
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
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
<+> SDoc
y SDoc -> SDoc -> SDoc
<+> SDoc
z)
(([Char] -> SDoc) -> [[Char]] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> SDoc
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
hcat ([SDoc] -> SDoc) -> ([[Char]] -> [SDoc]) -> [[Char]] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
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
text) [[[Char]]]
names)
((SrcSpan -> SDoc) -> [SrcSpan] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
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 (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 (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
text [Char]
start_bold SDoc -> SDoc -> SDoc
<> SDoc
c SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
end_bold
| Bool
otherwise = SDoc
c
backCmd :: GhciMonad m => String -> m ()
backCmd :: forall (m :: Type -> Type). GhciMonad m => [Char] -> m ()
backCmd [Char]
arg
| [Char] -> 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 (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
$ PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"Logged breakpoint at") SDoc -> SDoc -> SDoc
<+> 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 (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 (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 PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"Stopped at")
else PtrString -> SDoc
ptext ([Char] -> PtrString
sLit [Char]
"Logged breakpoint at")) SDoc -> SDoc -> SDoc
<+> 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 (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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null [[Char]]
rest) = do
Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
wantInterpretedModule [Char]
arg1
Module -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> [[Char]] -> m ()
breakByModule Module
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
Module
md <- ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
lookupModuleName ModuleName
mn
Module -> Int -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> Int -> [[Char]] -> m ()
breakByModuleLine Module
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg1) [[Char]]
rest
[] -> do
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"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 =>
Module -> [[Char]] -> m ()
breakByModule Module
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
Module -> Int -> [[Char]] -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> Int -> [[Char]] -> m ()
breakByModuleLine Module
md ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
arg1) [[Char]]
rest
breakByModule Module
_ [[Char]]
_
= m ()
forall a. a
breakSyntax
breakByModuleLine :: GhciMonad m => Module -> Int -> [String] -> m ()
breakByModuleLine :: forall (m :: Type -> Type).
GhciMonad m =>
Module -> Int -> [[Char]] -> m ()
breakByModuleLine Module
md Int
line [[Char]]
args
| [] <- [[Char]]
args = Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet Module
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 =
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet Module
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 Module
mb_mod <- m (Maybe Module)
-> (SomeException -> m (Maybe Module)) -> m (Maybe Module)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ([Char] -> m (Maybe Module)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Module)
lookupModuleInscope [Char]
mod_top_lvl)
(\(SomeException
_ :: SomeException) -> [Char] -> m (Maybe Module)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Module)
lookupModuleInGraph [Char]
mod_str)
Maybe SDoc
mb_err_msg <- [Char] -> [Char] -> Maybe Module -> m (Maybe SDoc)
forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> [Char] -> Maybe Module -> m (Maybe SDoc)
validateBP [Char]
mod_str [Char]
fun_str Maybe Module
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
text [Char]
"Cannot set breakpoint on" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
text [Char]
inp)
SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
":" SDoc -> SDoc -> SDoc
<+> SDoc
err_msg
Maybe SDoc
Nothing -> do
Maybe ModuleInfo
mb_mod_info <- Module -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo (Module -> m (Maybe ModuleInfo)) -> Module -> m (Maybe ModuleInfo)
forall a b. (a -> b) -> a -> b
$ Maybe Module -> Module
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Module
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
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
forall (m :: Type -> Type).
GhciMonad m =>
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet (Maybe Module -> Module
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Module
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 Module)
lookupModuleInscope [Char]
mod_top_lvl = do
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
mod_top_lvl
Maybe Module -> m (Maybe Module)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Module -> m (Maybe Module))
-> Maybe Module -> m (Maybe Module)
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just (Module -> Maybe Module) -> Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ [Module] -> Module
forall a. [a] -> a
head ([Module] -> Module) -> [Module] -> Module
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
Name -> Module
GHC.nameModule (Name -> Module) -> [Name] -> [Module]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names
lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
lookupModuleInGraph :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> m (Maybe Module)
lookupModuleInGraph [Char]
mod_str = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let hmods :: [Module]
hmods = ModSummary -> Module
ms_mod (ModSummary -> Module) -> [ModSummary] -> [Module]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph
Maybe Module -> m (Maybe Module)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Module -> m (Maybe Module))
-> Maybe Module -> m (Maybe Module)
forall a b. (a -> b) -> a -> b
$ (Module -> Bool) -> [Module] -> Maybe Module
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) -> (Module -> [Char]) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Char]
showModule) [Module]
hmods
validateBP :: GhciMonad m => String -> String -> Maybe Module
-> m (Maybe SDoc)
validateBP :: forall (m :: Type -> Type).
GhciMonad m =>
[Char] -> [Char] -> Maybe Module -> m (Maybe SDoc)
validateBP [Char]
mod_str [Char]
fun_str Maybe Module
Nothing = Maybe SDoc -> m (Maybe SDoc)
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
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
<+> [Char] -> SDoc
text [Char]
"not in scope"
validateBP [Char]
_ [Char]
"" (Just Module
_) = Maybe SDoc -> m (Maybe SDoc)
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
text [Char]
"Function name is missing"
validateBP [Char]
_ [Char]
fun_str (Just Module
modl) = do
Bool
isInterpr <- Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
modl
(ForeignRef BreakArray
_, Array Int SrcSpan
_, Array Int [[Char]]
decls) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
modl
Maybe SDoc
mb_err_msg <- case Bool
isInterpr of
Bool
False -> Maybe SDoc -> m (Maybe SDoc)
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
text [Char]
"Module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl)
SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
"is not interpreted"
Bool
True -> case [Char]
fun_str [Char] -> [[Char]] -> 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 (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
text [Char]
"No breakpoint found for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes ([Char] -> SDoc
text [Char]
fun_str)
SDoc -> SDoc -> SDoc
<+> SDoc
"in module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl)
Bool
True -> Maybe SDoc -> m (Maybe SDoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe SDoc
forall a. Maybe a
Nothing
Maybe SDoc -> m (Maybe SDoc)
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 =>
Module -> (TickArray -> [(Int, RealSrcSpan)]) -> m ()
findBreakAndSet Module
md TickArray -> [(Int, RealSrcSpan)]
lookupTickTree = do
TickArray
tickArray <- Module -> m TickArray
forall (m :: Type -> Type). GhciMonad m => Module -> m TickArray
getTickArray Module
md
(ForeignRef BreakArray
breakArray, Array Int SrcSpan
_, Array Int [[Char]]
_) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
md
case TickArray -> [(Int, RealSrcSpan)]
lookupTickTree TickArray
tickArray of
[] -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> 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_ (ForeignRef BreakArray -> (Int, RealSrcSpan) -> m ()
forall {m :: Type -> Type}.
GhciMonad m =>
ForeignRef BreakArray -> (Int, RealSrcSpan) -> m ()
breakAt ForeignRef BreakArray
breakArray) [(Int, RealSrcSpan)]
some
where
breakAt :: ForeignRef BreakArray -> (Int, RealSrcSpan) -> m ()
breakAt ForeignRef BreakArray
breakArray (Int
tick, RealSrcSpan
pan) = do
Bool -> ForeignRef BreakArray -> Int -> m ()
forall (m :: Type -> Type).
GhcMonad m =>
Bool -> ForeignRef BreakArray -> Int -> m ()
setBreakFlag Bool
True ForeignRef BreakArray
breakArray Int
tick
(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 :: Module -> SrcSpan -> Int -> Bool -> [Char] -> BreakLocation
BreakLocation
{ breakModule :: Module
breakModule = Module
md
, breakLoc :: SrcSpan
breakLoc = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
pan Maybe BufSpan
forall a. Maybe a
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
text [Char]
"Breakpoint " SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
nm SDoc -> SDoc -> SDoc
<>
if Bool
alreadySet
then [Char] -> SDoc
text [Char]
" was already set at " SDoc -> SDoc -> SDoc
<> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
pan
else [Char] -> SDoc
text [Char]
" activated at " SDoc -> SDoc -> SDoc
<> 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 (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 (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
forall {a}. (a, RealSrcSpan) -> Bool
ends_here [(Int, RealSrcSpan)]
starts_here
where ends_here :: (a, RealSrcSpan) -> Bool
ends_here (a
_,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
forall {a}. (a, 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 :: (a, RealSrcSpan) -> Bool
enclosed (a
_,RealSrcSpan
sp0) = ((Int, RealSrcSpan) -> Bool) -> [(Int, RealSrcSpan)] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (Int, RealSrcSpan) -> Bool
forall {a}. (a, RealSrcSpan) -> Bool
subspan [(Int, RealSrcSpan)]
ticks
where subspan :: (a, RealSrcSpan) -> Bool
subspan (a
_,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
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 (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 (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just [[Char]]
strs -> IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([[Char]] -> [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
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. [Char] -> a
panic [Char]
"No resumes"
(Resume
r:[Resume]
_) ->
do let traceIt :: SDoc
traceIt = case Resume -> [History]
GHC.resumeHistory Resume
r of
[] -> [Char] -> SDoc
text [Char]
"rerunning with :trace,"
[History]
_ -> SDoc
empty
doWhat :: SDoc
doWhat = SDoc
traceIt SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
":back then :list"
SDoc -> m ()
forall (m :: Type -> Type). GhcMonad m => SDoc -> m ()
printForUser ([Char] -> SDoc
text [Char]
"Unable to list source for" SDoc -> SDoc -> SDoc
<+>
SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
pan
SDoc -> SDoc -> SDoc
$$ [Char] -> SDoc
text [Char]
"Try" SDoc -> SDoc -> SDoc
<+> 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 (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
Module
md <- ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
lookupModuleName ModuleName
mn
Module -> Int -> m ()
forall (m :: Type -> Type). GhcMonad m => Module -> Int -> m ()
listModuleLine Module
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
Module
md <- [Char] -> m Module
forall (m :: Type -> Type). GhcMonad m => [Char] -> m Module
wantInterpretedModule [Char]
arg1
Module -> Int -> m ()
forall (m :: Type -> Type). GhcMonad m => Module -> Int -> m ()
listModuleLine Module
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 <- ASSERT( isExternalName name )
Module -> m TickArray
forall (m :: Type -> Type). GhciMonad m => Module -> m TickArray
getTickArray (HasDebugCallStack => Name -> Module
Name -> Module
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
text [Char]
"can't find its location: " SDoc -> SDoc -> SDoc
<>
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
text [Char]
"cannot list source code for " SDoc -> SDoc -> SDoc
<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n SDoc -> SDoc -> SDoc
<> [Char] -> SDoc
text [Char]
": " SDoc -> SDoc -> SDoc
<> SDoc
why
list2 [[Char]]
_other =
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"syntax: :list [<line> | <module> <line> | <identifier>]"
listModuleLine :: GHC.GhcMonad m => Module -> Int -> m ()
listModuleLine :: forall (m :: Type -> Type). GhcMonad m => Module -> Int -> m ()
listModuleLine Module
modl Int
line = do
ModuleGraph
graph <- m ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
let this :: Maybe ModSummary
this = ModuleGraph -> Module -> Maybe ModSummary
GHC.mgLookupModule ModuleGraph
graph Module
modl
case Maybe ModSummary
this of
Maybe ModSummary
Nothing -> [Char] -> m ()
forall a. [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 (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 (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 (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 => Module -> m TickArray
getTickArray Module
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 -> Module -> Maybe TickArray
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv TickArray
arrmap Module
modl of
Just TickArray
arr -> TickArray -> m TickArray
forall (m :: Type -> Type) a. Monad m => a -> m a
return TickArray
arr
Maybe TickArray
Nothing -> do
(ForeignRef BreakArray
_breakArray, Array Int SrcSpan
ticks, Array Int [[Char]]
_) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
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 :: ModuleEnv TickArray
tickarrays = ModuleEnv TickArray -> Module -> TickArray -> ModuleEnv TickArray
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv TickArray
arrmap Module
modl TickArray
arr}
TickArray -> m TickArray
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 :: ModuleEnv TickArray
tickarrays = ModuleEnv TickArray
forall a. ModuleEnv a
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 (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).
GhcMonad 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 BreakLocation
breaks = IntMap BreakLocation
forall a. IntMap a
IntMap.empty }
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
text [Char]
"Breakpoint" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
identity SDoc -> SDoc -> SDoc
<+>
[Char] -> SDoc
text [Char]
"does not exist")
Just BreakLocation
loc -> do
BreakLocation
_ <- (Bool -> BreakLocation -> m BreakLocation
forall (m :: Type -> Type).
GhcMonad 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 :: IntMap BreakLocation
breaks = IntMap BreakLocation
rest }
turnBreakOnOff :: GHC.GhcMonad m => Bool -> BreakLocation -> m BreakLocation
turnBreakOnOff :: forall (m :: Type -> Type).
GhcMonad 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 (m :: Type -> Type) a. Monad m => a -> m a
return BreakLocation
loc
| Bool
otherwise = do
(ForeignRef BreakArray
arr, Array Int SrcSpan
_, Array Int [[Char]]
_) <- Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak (BreakLocation -> Module
breakModule BreakLocation
loc)
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
enableBreakpoint HscEnv
hsc_env ForeignRef BreakArray
arr (BreakLocation -> Int
breakTick BreakLocation
loc) Bool
onOff
BreakLocation -> m BreakLocation
forall (m :: Type -> Type) a. Monad m => a -> m a
return BreakLocation
loc { breakEnabled :: Bool
breakEnabled = Bool
onOff }
getModBreak :: GHC.GhcMonad m
=> Module -> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [String])
getModBreak :: forall (m :: Type -> Type).
GhcMonad m =>
Module
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
getModBreak Module
m = do
ModuleInfo
mod_info <- ModuleInfo -> Maybe ModuleInfo -> ModuleInfo
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ModuleInfo
forall a. [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
<$> Module -> m (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo Module
m
let modBreaks :: ModBreaks
modBreaks = ModuleInfo -> ModBreaks
GHC.modInfoModBreaks ModuleInfo
mod_info
let arr :: ForeignRef BreakArray
arr = ModBreaks -> ForeignRef BreakArray
GHC.modBreaks_flags ModBreaks
modBreaks
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
(ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
-> m (ForeignRef BreakArray, Array Int SrcSpan, Array Int [[Char]])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ForeignRef BreakArray
arr, Array Int SrcSpan
ticks, Array Int [[Char]]
decls)
setBreakFlag :: GHC.GhcMonad m => Bool -> ForeignRef BreakArray -> Int -> m ()
setBreakFlag :: forall (m :: Type -> Type).
GhcMonad m =>
Bool -> ForeignRef BreakArray -> Int -> m ()
setBreakFlag Bool
toggle ForeignRef BreakArray
arr Int
i = do
HscEnv
hsc_env <- m HscEnv
forall (m :: Type -> Type). GhcMonad m => m HscEnv
GHC.getSession
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
enableBreakpoint HscEnv
hsc_env ForeignRef BreakArray
arr Int
i Bool
toggle
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.
(HasDynFlags 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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False)
showException :: MonadIO m => SomeException -> m ()
showException :: forall (m :: Type -> Type). MonadIO m => SomeException -> m ()
showException SomeException
se =
IO () -> m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
ghciHandle :: (HasDynFlags m, ExceptionMonad m) => (SomeException -> m a) -> m a -> m a
ghciHandle :: forall (m :: Type -> Type) a.
(HasDynFlags 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 (m :: Type -> Type) b.
MonadMask m =>
((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
!DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
m a -> (SomeException -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (m a -> m a
forall a. m a -> m a
restore (DynFlags -> m a -> m a
forall (m :: Type -> Type) a.
ExceptionMonad m =>
DynFlags -> m a -> m a
GHC.prettyPrintGhcErrors DynFlags
dflags 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 (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 (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> Either SomeException a -> m (Either SomeException 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 (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
Right a
_ -> Bool -> m Bool
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 Module
lookupModule [Char]
mName = ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
lookupModuleName ([Char] -> ModuleName
GHC.mkModuleName [Char]
mName)
lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
lookupModuleName :: forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
lookupModuleName ModuleName
mName = ModuleName -> Maybe FastString -> m Module
forall (m :: Type -> Type).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
GHC.lookupModule ModuleName
mName Maybe FastString
forall a. Maybe a
Nothing
isMainUnitModule :: Module -> Bool
isMainUnitModule :: Module -> Bool
isMainUnitModule Module
m = Module -> Unit
forall unit. GenModule unit -> unit
GHC.moduleUnit Module
m Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit
showModule :: Module -> String
showModule :: Module -> [Char]
showModule = ModuleName -> [Char]
moduleNameString (ModuleName -> [Char])
-> (Module -> ModuleName) -> Module -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName
declPath :: [String] -> String
declPath :: [[Char]] -> [Char]
declPath = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"."
expandPath :: MonadIO m => String -> m String
expandPath :: forall (m :: Type -> Type). MonadIO m => [Char] -> m [Char]
expandPath = IO [Char] -> m [Char]
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 (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 (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 Module
wantInterpretedModule [Char]
str = ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName ([Char] -> ModuleName
GHC.mkModuleName [Char]
str)
wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName :: forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName ModuleName
modname = do
Module
modl <- ModuleName -> m Module
forall (m :: Type -> Type). GhcMonad m => ModuleName -> m Module
lookupModuleName ModuleName
modname
let str :: [Char]
str = ModuleName -> [Char]
moduleNameString ModuleName
modname
DynFlags
dflags <- m DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (DynFlags -> Module -> Bool
isHomeModule DynFlags
dflags Module
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 <- Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
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"))
Module -> m Module
forall (m :: Type -> Type) a. Monad m => a -> m a
return Module
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). GhcMonad m => SourceError -> m ()
GHC.printException (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Name]
names <- [Char] -> m [Name]
forall (m :: Type -> Type). GhcMonad m => [Char] -> m [Name]
GHC.parseName [Char]
str
case [Name]
names of
[] -> () -> m ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
(Name
n:[Name]
_) -> do
let modl :: Module
modl = ASSERT( isExternalName n ) GHC.nameModule 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
<>
[Char] -> SDoc
text [Char]
" is not defined in an interpreted module"
else do
Bool
is_interpreted <- Module -> m Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
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
text [Char]
"module " SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
modl SDoc -> SDoc -> SDoc
<>
[Char] -> SDoc
text [Char]
" is not interpreted"
else Name -> m ()
and_then Name
n
clearAllTargets :: GhciMonad m => m ()
clearAllTargets :: forall (m :: Type -> Type). GhciMonad m => m ()
clearAllTargets = m ()
forall (m :: Type -> Type). GhciMonad m => m ()
discardActiveBreakPoints
m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> [Target] -> m ()
forall (m :: Type -> Type). GhcMonad m => [Target] -> m ()
GHC.setTargets []
m () -> m SuccessFlag -> m SuccessFlag
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> LoadHowMuch -> m SuccessFlag
forall (m :: Type -> Type).
GhcMonad m =>
LoadHowMuch -> m SuccessFlag
GHC.load LoadHowMuch
LoadAllTargets
m SuccessFlag -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
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. [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 (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Char]
mod = [Char]
ident
| [Char] -> 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