{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DuplicateRecordFields     #-}
{-# LANGUAGE ExtendedDefaultRules      #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE ViewPatterns              #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

{- |
A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.

For a full example see the "Ide.Plugin.Eval.Tutorial" module.
-}
module Ide.Plugin.Eval.CodeLens (
    codeLens,
    evalCommand,
) where

import           Control.Applicative                          (Alternative ((<|>)))
import           Control.Arrow                                (second, (>>>))
import           Control.Exception                            (try)
import qualified Control.Exception                            as E
import           Control.Lens                                 (_1, _3, ix, (%~),
                                                               (<&>), (^.))
import           Control.Monad                                (guard, join,
                                                               void, when)
import           Control.Monad.IO.Class                       (MonadIO (liftIO))
import           Control.Monad.Trans                          (lift)
import           Control.Monad.Trans.Except                   (ExceptT (..))
import           Data.Aeson                                   (toJSON)
import           Data.Char                                    (isSpace)
import           Data.Default
import qualified Data.HashMap.Strict                          as HashMap
import           Data.List                                    (dropWhileEnd,
                                                               find,
                                                               intercalate,
                                                               intersperse)
import           Data.Maybe                                   (catMaybes,
                                                               fromMaybe)
import           Data.String                                  (IsString)
import           Data.Text                                    (Text)
import qualified Data.Text                                    as T
import           Data.Time                                    (getCurrentTime)
import           Data.Typeable                                (Typeable)
import           Development.IDE                              (GetDependencyInformation (..),
                                                               GetLinkable (..),
                                                               GetModSummary (..),
                                                               GhcSessionIO (..),
                                                               IdeState,
                                                               ModSummaryResult (..),
                                                               NeedsCompilation (NeedsCompilation),
                                                               VFSModified (..),
                                                               evalGhcEnv,
                                                               hscEnvWithImportPaths,
                                                               linkableHomeMod,
                                                               printOutputable,
                                                               runAction,
                                                               textToStringBuffer,
                                                               toNormalizedFilePath',
                                                               uriToFilePath',
                                                               useNoFile_,
                                                               useWithStale_,
                                                               use_, uses_)
import           Development.IDE.Core.Rules                   (GhcSessionDepsConfig (..),
                                                               ghcSessionDepsDefinition)
import           Development.IDE.GHC.Compat                   hiding (typeKind,
                                                               unitState)
import qualified Development.IDE.GHC.Compat                   as Compat
import qualified Development.IDE.GHC.Compat                   as SrcLoc
import           Development.IDE.GHC.Compat.Util              (GhcException,
                                                               OverridingBool (..))
import           Development.IDE.Import.DependencyInformation (reachableModules)
import           Development.IDE.Types.Options
import           GHC                                          (ClsInst,
                                                               ExecOptions (execLineNumber, execSourceFile),
                                                               FamInst,
                                                               GhcMonad,
                                                               LoadHowMuch (LoadAllTargets),
                                                               NamedThing (getName),
                                                               defaultFixity,
                                                               execOptions,
                                                               exprType,
                                                               getInfo,
                                                               getInteractiveDynFlags,
                                                               isImport, isStmt,
                                                               load, parseName,
                                                               pprFamInst,
                                                               pprInstance,
                                                               setTargets,
                                                               typeKind)
#if MIN_VERSION_ghc(9,2,0)
import           GHC                                          (Fixity)
#endif
import qualified GHC.LanguageExtensions.Type                  as LangExt (Extension (..))

import           Development.IDE.Core.FileStore               (setSomethingModified)
import           Development.IDE.Types.Shake                  (toKey)
import           Ide.Plugin.Config                            (Config)
#if MIN_VERSION_ghc(9,2,0)
import           GHC.Types.SrcLoc                             (UnhelpfulSpanReason (UnhelpfulInteractive))
#endif
import           Ide.Plugin.Eval.Code                         (Statement,
                                                               asStatements,
                                                               evalSetup,
                                                               myExecStmt,
                                                               propSetup,
                                                               resultRange,
                                                               testCheck,
                                                               testRanges)
import           Ide.Plugin.Eval.Config                       (EvalConfig (..),
                                                               getEvalConfig)
import           Ide.Plugin.Eval.GHC                          (addImport,
                                                               addPackages,
                                                               hasPackage,
                                                               showDynFlags)
import           Ide.Plugin.Eval.Parse.Comments               (commentsToSections)
import           Ide.Plugin.Eval.Parse.Option                 (parseSetFlags)
import           Ide.Plugin.Eval.Rules                        (queueForEvaluation)
import           Ide.Plugin.Eval.Types
import           Ide.Plugin.Eval.Util                         (gStrictTry,
                                                               isLiterate,
                                                               logWith,
                                                               response', timed)
import           Ide.PluginUtils                              (handleMaybe,
                                                               handleMaybeM,
                                                               pluginResponse)
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types                           hiding
                                                              (SemanticTokenAbsolute (length, line),
                                                               SemanticTokenRelative (length))
import           Language.LSP.Types.Lens                      (end, line)
import           Language.LSP.VFS                             (virtualFileText)

#if MIN_VERSION_ghc(9,2,0)
#elif MIN_VERSION_ghc(9,0,0)
import           GHC.Driver.Session                           (unitDatabases,
                                                               unitState)
import           GHC.Types.SrcLoc                             (UnhelpfulSpanReason (UnhelpfulInteractive))
#else
import           DynFlags
#endif


{- | Code Lens provider
 NOTE: Invoked every time the document is modified, not just when the document is saved.
-}
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
codeLens :: PluginMethodHandler IdeState 'TextDocumentCodeLens
codeLens IdeState
st PluginId
plId CodeLensParams{TextDocumentIdentifier
$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_textDocument} =
    let dbg :: a1 -> a2 -> m ()
dbg = forall (m :: * -> *) a1 a2.
(HasCallStack, MonadIO m, Show a1, Show a2) =>
IdeState -> a1 -> a2 -> m ()
logWith IdeState
st
        perf :: t -> m b -> m b
perf = forall (m :: * -> *) t a b.
MonadIO m =>
(t -> String -> m a) -> t -> m b -> m b
timed forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg
     in forall {m :: * -> *} {t} {b}.
(MonadIO m, Show t) =>
t -> m b -> m b
perf String
"codeLens" forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
pluginResponse forall a b. (a -> b) -> a -> b
$ do
                let TextDocumentIdentifier Uri
uri = TextDocumentIdentifier
_textDocument
                String
fp <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"uri" forall a b. (a -> b) -> a -> b
$ Uri -> Maybe String
uriToFilePath' Uri
uri
                let nfp :: NormalizedFilePath
nfp = String -> NormalizedFilePath
toNormalizedFilePath' String
fp
                    isLHS :: Bool
isLHS = String -> Bool
isLiterate String
fp
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"fp" String
fp
                (Comments
comments, PositionMapping
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    forall a. String -> IdeState -> Action a -> IO a
runAction String
"eval.GetParsedModuleWithComments" IdeState
st forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetEvalComments
GetEvalComments NormalizedFilePath
nfp
                -- dbg "excluded comments" $ show $  DL.toList $
                --     foldMap (\(L a b) ->
                --         case b of
                --             AnnLineComment{}  -> mempty
                --             AnnBlockComment{} -> mempty
                --             _                 -> DL.singleton (a, b)
                --     )
                --     $ apiAnnComments' pm_annotations
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"comments" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Comments
comments

                -- Extract tests from source code
                let Sections{[Section]
setupSections :: Sections -> [Section]
nonSetupSections :: Sections -> [Section]
setupSections :: [Section]
nonSetupSections :: [Section]
..} = Bool -> Comments -> Sections
commentsToSections Bool
isLHS Comments
comments
                    tests :: [(Section, Int, Test)]
tests = [Section] -> [(Section, Int, Test)]
testsBySection [Section]
nonSetupSections
                    cmd :: Command
cmd = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId CommandId
evalCommandName Text
"Evaluate=..." (forall a. a -> Maybe a
Just [])
                let lenses :: [CodeLens]
lenses =
                        [ Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
testRange (forall a. a -> Maybe a
Just Command
cmd') forall a. Maybe a
Nothing
                        | (Section
section, Int
ident, Test
test) <- [(Section, Int, Test)]
tests
                        , let (Range
testRange, Range
resultRange) = Test -> (Range, Range)
testRanges Test
test
                              args :: EvalParams
args = [Section] -> TextDocumentIdentifier -> Int -> EvalParams
EvalParams ([Section]
setupSections forall a. [a] -> [a] -> [a]
++ [Section
section]) TextDocumentIdentifier
_textDocument Int
ident
                              cmd' :: Command
cmd' =
                                (Command
cmd :: Command)
                                    { $sel:_arguments:Command :: Maybe (List Value)
_arguments = forall a. a -> Maybe a
Just (forall a. [a] -> List a
List [forall a. ToJSON a => a -> Value
toJSON EvalParams
args])
                                    , $sel:_title:Command :: Text
_title =
                                        if Range -> Bool
trivial Range
resultRange
                                            then Text
"Evaluate..."
                                            else Text
"Refresh..."
                                    }
                        ]

                forall {m :: * -> *} {t} {b}.
(MonadIO m, Show t) =>
t -> m b -> m b
perf String
"tests" forall a b. (a -> b) -> a -> b
$
                    forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"Tests" forall a b. (a -> b) -> a -> b
$
                        [String] -> String
unwords
                            [ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Section, Int, Test)]
tests)
                            , String
"tests in"
                            , forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Section]
nonSetupSections)
                            , String
"sections"
                            , forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Section]
setupSections)
                            , String
"setups"
                            , forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeLens]
lenses)
                            , String
"lenses."
                            ]

                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [CodeLens]
lenses
  where
    trivial :: Range -> Bool
trivial (Range Position
p Position
p') = Position
p forall a. Eq a => a -> a -> Bool
== Position
p'

evalCommandName :: CommandId
evalCommandName :: CommandId
evalCommandName = CommandId
"evalCommand"

evalCommand :: PluginId -> PluginCommand IdeState
evalCommand :: PluginId -> PluginCommand IdeState
evalCommand PluginId
plId = forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
evalCommandName Text
"evaluate" (PluginId -> CommandFunction IdeState EvalParams
runEvalCmd PluginId
plId)

type EvalId = Int

runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams
runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams
runEvalCmd PluginId
plId IdeState
st EvalParams{Int
[Section]
TextDocumentIdentifier
evalId :: EvalParams -> Int
module_ :: EvalParams -> TextDocumentIdentifier
sections :: EvalParams -> [Section]
evalId :: Int
module_ :: TextDocumentIdentifier
sections :: [Section]
..} =
    let dbg :: a1 -> a2 -> m ()
dbg = forall (m :: * -> *) a1 a2.
(HasCallStack, MonadIO m, Show a1, Show a2) =>
IdeState -> a1 -> a2 -> m ()
logWith IdeState
st
        perf :: t -> m b -> m b
perf = forall (m :: * -> *) t a b.
MonadIO m =>
(t -> String -> m a) -> t -> m b -> m b
timed forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg
        cmd :: ExceptT String (LspM Config) WorkspaceEdit
        cmd :: ExceptT String (LspM Config) WorkspaceEdit
cmd = do
            let tests :: [(Section, Test)]
tests = forall a b. (a -> b) -> [a] -> [b]
map (\(Section
a,Int
_,Test
b) -> (Section
a,Test
b)) forall a b. (a -> b) -> a -> b
$ [Section] -> [(Section, Int, Test)]
testsBySection [Section]
sections

            let TextDocumentIdentifier{Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri} = TextDocumentIdentifier
module_
            String
fp <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
"uri" forall a b. (a -> b) -> a -> b
$ Uri -> Maybe String
uriToFilePath' Uri
_uri
            let nfp :: NormalizedFilePath
nfp = String -> NormalizedFilePath
toNormalizedFilePath' String
fp
            Text
mdlText <- forall e c (m :: * -> *).
(IsString e, MonadLsp c m) =>
Uri -> ExceptT e m Text
moduleText Uri
_uri

            -- enable codegen
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IdeState -> NormalizedFilePath -> IO ()
queueForEvaluation IdeState
st NormalizedFilePath
nfp
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ VFSModified -> IdeState -> [Key] -> String -> IO ()
setSomethingModified VFSModified
VFSUnmodified IdeState
st [forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey NeedsCompilation
NeedsCompilation NormalizedFilePath
nfp] String
"Eval"

            HscEnv
session <- forall (m :: * -> *).
MonadIO m =>
IdeState -> NormalizedFilePath -> m HscEnv
runGetSession IdeState
st NormalizedFilePath
nfp

            ModSummary
ms <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModSummaryResult -> ModSummary
msrModSummary forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                    forall a. String -> IdeState -> Action a -> IO a
runAction String
"runEvalCmd.getModSummary" IdeState
st forall a b. (a -> b) -> a -> b
$
                        forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
nfp

            UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime

            let modName :: ModuleName
modName = forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ ModSummary -> Module
ms_mod ModSummary
ms
                thisModuleTarget :: Target
thisModuleTarget =
                    TargetId -> Bool -> Maybe (InputFileBuffer, UTCTime) -> Target
Target
                        (String -> Maybe Phase -> TargetId
TargetFile String
fp forall a. Maybe a
Nothing)
                        Bool
False
                        (forall a. a -> Maybe a
Just (Text -> InputFileBuffer
textToStringBuffer Text
mdlText, UTCTime
now))

            -- Setup environment for evaluation
            HscEnv
hscEnv' <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) b.
(MonadIO m, MonadCatch m) =>
m b -> m (Either String b)
gStrictTry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
session forall a b. (a -> b) -> a -> b
$ do
                HscEnv
env <- forall (m :: * -> *). GhcMonad m => m HscEnv
getSession

                -- Install the module pragmas and options
                DynFlags
df <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike HscEnv
env forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms

                -- Restore the original import paths
                let impPaths :: [String]
impPaths = DynFlags -> [String]
importPaths forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
env
                DynFlags
df <- forall (m :: * -> *) a. Monad m => a -> m a
return DynFlags
df{importPaths :: [String]
importPaths = [String]
impPaths}

                -- Set the modified flags in the session
                ()
_lp <- forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setSessionDynFlags DynFlags
df

                -- property tests need QuickCheck
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Section, Test)] -> Bool
needsQuickCheck [(Section, Test)]
tests) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [String] -> Ghc (Either String DynFlags)
addPackages [String
"QuickCheck"]
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"QUICKCHECK NEEDS" forall a b. (a -> b) -> a -> b
$ [(Section, Test)] -> Bool
needsQuickCheck [(Section, Test)]
tests
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"QUICKCHECK HAS" forall a b. (a -> b) -> a -> b
$ DynFlags -> Bool
hasQuickCheck DynFlags
df

                -- copy the package state to the interactive DynFlags
                DynFlags
idflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
getInteractiveDynFlags
                DynFlags
df <- forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
                -- set the identical DynFlags as GHCi
                -- Source: https://github.com/ghc/ghc/blob/5abf59976c7335df760e5d8609d9488489478173/ghc/GHCi/UI.hs#L473-L483
                -- This needs to be done manually since the default flags are not visible externally.
                let df' :: DynFlags
df' = forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> Extension -> DynFlags
xopt_set    Extension
LangExt.ExtendedDefaultRules
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> Extension -> DynFlags
xopt_unset  Extension
LangExt.MonomorphismRestriction
                        forall a b. (a -> b) -> a -> b
$ DynFlags
idflags
                forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags forall a b. (a -> b) -> a -> b
$ DynFlags
df'
#if MIN_VERSION_ghc(9,0,0)
                        {
                        packageFlags :: [PackageFlag]
packageFlags =
                            DynFlags -> [PackageFlag]
packageFlags
                                DynFlags
df
                        , useColor :: OverridingBool
useColor = OverridingBool
Never
                        , canUseColor :: Bool
canUseColor = Bool
False
                        }
#else
                        { pkgState =
                            pkgState
                                df
                        , pkgDatabase =
                            pkgDatabase
                                df
                        , packageFlags =
                            packageFlags
                                df
                        , useColor = Never
                        , canUseColor = False
                        }
#endif

                -- Load the module with its current content (as the saved module might not be up to date)
                -- BUG: this fails for files that requires preprocessors (e.g. CPP) for ghc < 8.8
                -- see https://gitlab.haskell.org/ghc/ghc/-/issues/17066
                -- and https://hackage.haskell.org/package/ghc-8.10.1/docs/GHC.html#v:TargetFile
                Either String ()
eSetTarget <- forall (m :: * -> *) b.
(MonadIO m, MonadCatch m) =>
m b -> m (Either String b)
gStrictTry forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => [Target] -> m ()
setTargets [Target
thisModuleTarget]
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"setTarget" Either String ()
eSetTarget

                -- load the module in the interactive environment
                SuccessFlag
loadResult <- forall {m :: * -> *} {t} {b}.
(MonadIO m, Show t) =>
t -> m b -> m b
perf String
"loadModule" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
load LoadHowMuch
LoadAllTargets
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"LOAD RESULT" forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> Text
printOutputable SuccessFlag
loadResult
                case SuccessFlag
loadResult of
                    SuccessFlag
Failed -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                        let err :: a
err = a
""
                        forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"load ERR" forall {a}. IsString a => a
err
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall {a}. IsString a => a
err
                    SuccessFlag
Succeeded -> do
                        -- Evaluation takes place 'inside' the module
                        forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
setContext [ModuleName -> InteractiveImport
Compat.IIModule ModuleName
modName]
                        forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
            EvalConfig
evalCfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadLsp Config m => PluginId -> m EvalConfig
getEvalConfig PluginId
plId

            -- Get linkables for all modules below us
            -- This can be optimised to only get the linkables for the symbols depended on by
            -- the statement we are parsing
            [LinkableResult]
lbs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"eval: GetLinkables" IdeState
st forall a b. (a -> b) -> a -> b
$ do
              [NormalizedFilePath]
linkables_needed <- DependencyInformation -> [NormalizedFilePath]
reachableModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetDependencyInformation
GetDependencyInformation NormalizedFilePath
nfp
              forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetLinkable
GetLinkable (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= NormalizedFilePath
nfp) [NormalizedFilePath]
linkables_needed) -- We don't need the linkable for the current module
            let hscEnv'' :: HscEnv
hscEnv'' = HscEnv
hscEnv' { hsc_HPT :: HomePackageTable
hsc_HPT  = HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt (HscEnv -> HomePackageTable
hsc_HPT HscEnv
hscEnv') [(forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module forall a b. (a -> b) -> a -> b
$ HomeModInfo -> ModIface
hm_iface HomeModInfo
hm, HomeModInfo
hm) | LinkableResult
lb <- [LinkableResult]
lbs, let hm :: HomeModInfo
hm = LinkableResult -> HomeModInfo
linkableHomeMod LinkableResult
lb] }

            [TextEdit]
edits <-
                forall {m :: * -> *} {t} {b}.
(MonadIO m, Show t) =>
t -> m b -> m b
perf String
"edits" forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                        forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
hscEnv'' forall a b. (a -> b) -> a -> b
$
                            EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]
runTests
                                EvalConfig
evalCfg
                                (IdeState
st, String
fp)
                                [(Section, Test)]
tests

            let workspaceEditsMap :: HashMap Uri (List TextEdit)
workspaceEditsMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Uri
_uri, forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ Text -> [TextEdit] -> [TextEdit]
addFinalReturn Text
mdlText [TextEdit]
edits)]
            let workspaceEdits :: WorkspaceEdit
workspaceEdits = Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just HashMap Uri (List TextEdit)
workspaceEditsMap) forall a. Maybe a
Nothing forall a. Maybe a
Nothing

            forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceEdit
workspaceEdits
     in forall {m :: * -> *} {t} {b}.
(MonadIO m, Show t) =>
t -> m b -> m b
perf String
"evalCmd" forall a b. (a -> b) -> a -> b
$
            forall c (m :: * -> *) a.
MonadLsp c m =>
Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress Text
"Evaluating" ProgressCancellable
Cancellable forall a b. (a -> b) -> a -> b
$
                forall c.
ExceptT String (LspM c) WorkspaceEdit
-> LspM c (Either ResponseError Value)
response' ExceptT String (LspM Config) WorkspaceEdit
cmd

addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
addFinalReturn Text
mdlText [TextEdit]
edits
    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TextEdit]
edits) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
mdlText) Bool -> Bool -> Bool
&& Text -> Char
T.last Text
mdlText forall a. Eq a => a -> a -> Bool
/= Char
'\n' =
        Text -> TextEdit
finalReturn Text
mdlText forall a. a -> [a] -> [a]
: [TextEdit]
edits
    | Bool
otherwise = [TextEdit]
edits

finalReturn :: Text -> TextEdit
finalReturn :: Text -> TextEdit
finalReturn Text
txt =
    let ls :: [Text]
ls = Text -> [Text]
T.lines Text
txt
        l :: b
l = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls forall a. Num a => a -> a -> a
-Int
1
        c :: b
c = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ [Text]
ls
        p :: Position
p = UInt -> UInt -> Position
Position forall {b}. Num b => b
l forall {b}. Num b => b
c
     in Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
p Position
p) Text
"\n"

moduleText :: (IsString e, MonadLsp c m) => Uri -> ExceptT e m Text
moduleText :: forall e c (m :: * -> *).
(IsString e, MonadLsp c m) =>
Uri -> ExceptT e m Text
moduleText Uri
uri =
    forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM e
"mdlText" forall a b. (a -> b) -> a -> b
$
      (VirtualFile -> Text
virtualFileText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile
              (Uri -> NormalizedUri
toNormalizedUri Uri
uri)

testsBySection :: [Section] -> [(Section, EvalId, Test)]
testsBySection :: [Section] -> [(Section, Int, Test)]
testsBySection [Section]
sections =
    [(Section
section, Int
ident, Test
test)
    | (Int
ident, Section
section) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Section]
sections
    , Test
test <- Section -> [Test]
sectionTests Section
section
    ]

type TEnv = (IdeState, String)

runTests :: EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]
runTests :: EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]
runTests EvalConfig{Bool
eval_cfg_exception :: EvalConfig -> Bool
eval_cfg_diff :: EvalConfig -> Bool
eval_cfg_exception :: Bool
eval_cfg_diff :: Bool
..} e :: TEnv
e@(IdeState
_st, String
_) [(Section, Test)]
tests = do
    DynFlags
df <- forall (m :: * -> *). GhcMonad m => m DynFlags
getInteractiveDynFlags
    Ghc ()
evalSetup
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Bool
hasQuickCheck DynFlags
df Bool -> Bool -> Bool
&& [(Section, Test)] -> Bool
needsQuickCheck [(Section, Test)]
tests) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
evals Bool
True TEnv
e DynFlags
df [Statement]
propSetup

    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit
processTest TEnv
e DynFlags
df) [(Section, Test)]
tests
  where
    processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit
    processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit
processTest e :: TEnv
e@(IdeState
st, String
fp) DynFlags
df (Section
section, Test
test) = do
        let dbg :: a1 -> a2 -> m ()
dbg = forall (m :: * -> *) a1 a2.
(HasCallStack, MonadIO m, Show a1, Show a2) =>
IdeState -> a1 -> a2 -> m ()
logWith IdeState
st
        let pad :: Text -> Text
pad = Text -> Text -> Text
pad_ forall a b. (a -> b) -> a -> b
$ (if String -> Bool
isLiterate String
fp then (Text
"> " Text -> Text -> Text
`T.append`) else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall p. IsString p => Format -> p
padPrefix (Section -> Format
sectionFormat Section
section)

        [Text]
rs <- TEnv -> DynFlags -> Test -> Ghc [Text]
runTest TEnv
e DynFlags
df Test
test
        forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"TEST RESULTS" [Text]
rs

        let checkedResult :: [Text]
checkedResult = Bool -> (Section, Test) -> [Text] -> [Text]
testCheck Bool
eval_cfg_diff (Section
section, Test
test) [Text]
rs
        let resultLines :: [Text]
resultLines = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
T.lines [Text]
checkedResult

        let edit :: TextEdit
edit = Format -> Test -> [Text] -> TextEdit
asEdit (Section -> Format
sectionFormat Section
section) Test
test (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
pad [Text]
resultLines)
        forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"TEST EDIT" TextEdit
edit
        forall (m :: * -> *) a. Monad m => a -> m a
return TextEdit
edit

    -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]
    runTest :: TEnv -> DynFlags -> Test -> Ghc [Text]
runTest TEnv
_ DynFlags
df Test
test
        | Bool -> Bool
not (DynFlags -> Bool
hasQuickCheck DynFlags
df) Bool -> Bool -> Bool
&& Test -> Bool
isProperty Test
test =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                String -> [Text]
singleLine
                    String
"Add QuickCheck to your cabal dependencies to run this test."
    runTest TEnv
e DynFlags
df Test
test = Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
evals (Bool
eval_cfg_exception Bool -> Bool -> Bool
&& Bool -> Bool
not (Test -> Bool
isProperty Test
test)) TEnv
e DynFlags
df (Test -> [Statement]
asStatements Test
test)

asEdit :: Format -> Test -> [Text] -> TextEdit
asEdit :: Format -> Test -> [Text] -> TextEdit
asEdit (MultiLine Range
commRange) Test
test [Text]
resultLines
    -- A test in a block comment, ending with @-\}@ without newline in-between.
    | Test -> Range
testRange Test
test forall s a. s -> Getting a s a -> a
^. forall s a. HasEnd s a => Lens' s a
endforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasLine s a => Lens' s a
line forall a. Eq a => a -> a -> Bool
== Range
commRange forall s a. s -> Getting a s a -> a
^. forall s a. HasEnd s a => Lens' s a
end forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasLine s a => Lens' s a
line
    =
    Range -> Text -> TextEdit
TextEdit
        (Position -> Position -> Range
Range
            (Test -> Range
testRange Test
test forall s a. s -> Getting a s a -> a
^. forall s a. HasEnd s a => Lens' s a
end)
            (Test -> Range
resultRange Test
test forall s a. s -> Getting a s a -> a
^. forall s a. HasEnd s a => Lens' s a
end)
        )
        (Text
"\n" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines ([Text]
resultLines forall a. Semigroup a => a -> a -> a
<> [Text
"-}"]))
asEdit Format
_ Test
test [Text]
resultLines =
    Range -> Text -> TextEdit
TextEdit (Test -> Range
resultRange Test
test) ([Text] -> Text
T.unlines [Text]
resultLines)

{-
The result of evaluating a test line can be:
* a value
* nothing
* a (possibly multiline) error message

A value is returned for a correct expression.

Either a pure value:
>>> 'h' :"askell"
"haskell"

Or an 'IO a' (output on stdout/stderr is ignored):
>>> print "OK" >> return "ABC"
"ABC"

Nothing is returned for a correct directive:

>>>:set -XFlexibleInstances
>>> import Data.Maybe

Nothing is returned for a correct declaration (let..,x=, data, class)

>>> let x = 11
>>> y = 22
>>> data B = T | F
>>> class C a

Nothing is returned for an empty line:

>>>

A, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:

>>>:set -XNonExistent
Some flags have not been recognized: -XNonExistent

>>> cls C
Variable not in scope: cls :: t0 -> t
Data constructor not in scope: C

>>> "A
lexical error in string/character literal at end of input

Exceptions are shown as if printed, but it can be configured to include prefix like
in GHCi or doctest. This allows it to be used as a hack to simulate print until we
get proper IO support. See #1977

>>> 3 `div` 0
divide by zero

>>> error "Something went wrong\nbad times" :: E.SomeException
Something went wrong
bad times

Or for a value that does not have a Show instance and can therefore not be displayed:
>>> data V = V
>>> V
No instance for (Show V) arising from a use of ‘evalPrint’
-}
evals :: Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
evals :: Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
evals Bool
mark_exception (IdeState
st, String
fp) DynFlags
df [Statement]
stmts = do
    Either String [Maybe [Text]]
er <- forall (m :: * -> *) b.
(MonadIO m, MonadCatch m) =>
m b -> m (Either String b)
gStrictTry forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> Ghc (Maybe [Text])
eval [Statement]
stmts
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either String [Maybe [Text]]
er of
        Left String
err -> String -> [Text]
errorLines String
err
        Right [Maybe [Text]]
rs -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ [Maybe [Text]]
rs
  where
    dbg :: a1 -> a2 -> m ()
dbg = forall (m :: * -> *) a1 a2.
(HasCallStack, MonadIO m, Show a1, Show a2) =>
IdeState -> a1 -> a2 -> m ()
logWith IdeState
st
    eval :: Statement -> Ghc (Maybe [Text])
    eval :: Statement -> Ghc (Maybe [Text])
eval (Located Int
l String
stmt)
        | -- GHCi flags
          Just (String -> [String]
words -> [String]
flags) <- String -> Maybe String
parseSetFlags String
stmt = do
            forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"{:SET" [String]
flags
            DynFlags
ndf <- forall (m :: * -> *). GhcMonad m => m DynFlags
getInteractiveDynFlags
            forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"pre set" forall a b. (a -> b) -> a -> b
$ DynFlags -> String
showDynFlags DynFlags
ndf
            Either GhcException (DynFlags, [Located String], [Warn])
eans <-
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @GhcException forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
parseDynamicFlagsCmdLine DynFlags
ndf
                (forall a b. (a -> b) -> [a] -> [b]
map (forall l e. l -> e -> GenLocated l e
L forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
unhelpfulReason) [String]
flags)
            forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"parsed flags" forall a b. (a -> b) -> a -> b
$ Either GhcException (DynFlags, [Located String], [Warn])
eans
              forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall s t a b. Field1 s t a b => Lens s t a b
_1 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DynFlags -> String
showDynFlags forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s t a b. Field3 s t a b => Lens s t a b
_3 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a b. (a -> b) -> [a] -> [b]
map Warn -> Located String
warnMsg)
            case Either GhcException (DynFlags, [Located String], [Warn])
eans of
                Left GhcException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> [Text]
errorLines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show GhcException
err
                Right (DynFlags
df', [Located String]
ignoreds, [Warn]
warns) -> do
                    let warnings :: m [Text]
warnings = do
                            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Warn]
warns
                            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> [Text]
errorLines forall a b. (a -> b) -> a -> b
$
                                [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
                                forall a b. (a -> b) -> [a] -> [b]
map Warn -> String
prettyWarn [Warn]
warns
                        igns :: m [Text]
igns = do
                            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located String]
ignoreds
                            forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                [Text
"Some flags have not been recognized: "
                                forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
SrcLoc.unLoc [Located String]
ignoreds)
                                ]
                    forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"post set" forall a b. (a -> b) -> a -> b
$ DynFlags -> String
showDynFlags DynFlags
df'
                    ()
_ <- forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setSessionDynFlags DynFlags
df'
                    DynFlags
sessDyns <- forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
                    forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags DynFlags
sessDyns
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. (Monad m, Alternative m) => m [Text]
warnings forall a. Semigroup a => a -> a -> a
<> forall {m :: * -> *}. (Monad m, Alternative m) => m [Text]
igns
        | -- A type/kind command
          Just (Text
cmd, Text
arg) <- Text -> Maybe (Text, Text)
parseGhciLikeCmd forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
stmt =
            Text -> Text -> Ghc (Maybe [Text])
evalGhciLikeCmd Text
cmd Text
arg
        | -- A statement
          ParserOpts -> String -> Bool
isStmt ParserOpts
pf String
stmt =
            do
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"{STMT " String
stmt
                Either String (Maybe String)
res <- String -> Int -> Ghc (Either String (Maybe String))
exec String
stmt Int
l
                let r :: Maybe [Text]
r = case Either String (Maybe String)
res of
                        Left String
err -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
mark_exception then String -> [Text]
exceptionLines else String -> [Text]
errorLines) forall a b. (a -> b) -> a -> b
$ String
err
                        Right Maybe String
x  -> String -> [Text]
singleLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
x
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"STMT} -> " Maybe [Text]
r
                forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
r
        | -- An import
          ParserOpts -> String -> Bool
isImport ParserOpts
pf String
stmt =
            do
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"{IMPORT " String
stmt
                [InteractiveImport]
_ <- forall (m :: * -> *). GhcMonad m => String -> m [InteractiveImport]
addImport String
stmt
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | -- A declaration
          Bool
otherwise =
            do
                forall {m :: * -> *} {a1} {a2}.
(MonadIO m, Show a1, Show a2) =>
a1 -> a2 -> m ()
dbg String
"{DECL " String
stmt
                forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). GhcMonad m => String -> m [Name]
runDecls String
stmt
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    pf :: ParserOpts
pf = DynFlags -> ParserOpts
initParserOpts DynFlags
df
#if !MIN_VERSION_ghc(9,0,0)
    unhelpfulReason = "<interactive>"
#else
    unhelpfulReason :: UnhelpfulSpanReason
unhelpfulReason = UnhelpfulSpanReason
UnhelpfulInteractive
#endif
    exec :: String -> Int -> Ghc (Either String (Maybe String))
exec String
stmt Int
l =
        let opts :: ExecOptions
opts = ExecOptions
execOptions{execSourceFile :: String
execSourceFile = String
fp, execLineNumber :: Int
execLineNumber = Int
l}
         in String -> ExecOptions -> Ghc (Either String (Maybe String))
myExecStmt String
stmt ExecOptions
opts

prettyWarn :: Warn -> String
prettyWarn :: Warn -> String
prettyWarn Warn{WarnReason
Located String
warnReason :: Warn -> WarnReason
warnMsg :: Located String
warnReason :: WarnReason
warnMsg :: Warn -> Located String
..} =
    Text -> String
T.unpack (forall a. Outputable a => a -> Text
printOutputable forall a b. (a -> b) -> a -> b
$ forall a. HasSrcSpan a => a -> SrcSpan
SrcLoc.getLoc Located String
warnMsg) forall a. Semigroup a => a -> a -> a
<> String
": warning:\n"
    forall a. Semigroup a => a -> a -> a
<> String
"    " forall a. Semigroup a => a -> a -> a
<> forall l e. GenLocated l e -> e
SrcLoc.unLoc Located String
warnMsg

runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv
runGetSession :: forall (m :: * -> *).
MonadIO m =>
IdeState -> NormalizedFilePath -> m HscEnv
runGetSession IdeState
st NormalizedFilePath
nfp = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"eval" IdeState
st forall a b. (a -> b) -> a -> b
$ do
    -- Create a new GHC Session rather than reusing an existing one
    -- to avoid interfering with ghcide
    -- UPDATE: I suspect that this doesn't really work, we always get the same Session
    --         we probably cache hscEnvs in the Session state
    IdeGhcSession{String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun :: IdeGhcSession -> String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun :: String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun} <- forall k v. IdeRule k v => k -> Action v
useNoFile_ GhcSessionIO
GhcSessionIO
    let fp :: String
fp = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp
    (([FileDiagnostic]
_, Maybe HscEnvEq
res),[String]
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun String
fp
    let env :: HscEnvEq
env = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown file: " forall a. Semigroup a => a -> a -> a
<> String
fp) Maybe HscEnvEq
res
        ghcSessionDepsConfig :: GhcSessionDepsConfig
ghcSessionDepsConfig = forall a. Default a => a
def
            { $sel:checkForImportCycles:GhcSessionDepsConfig :: Bool
checkForImportCycles = Bool
False
            }
    Maybe HscEnv
res <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HscEnvEq -> HscEnv
hscEnvWithImportPaths forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> GhcSessionDepsConfig
-> HscEnvEq
-> NormalizedFilePath
-> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition Bool
True GhcSessionDepsConfig
ghcSessionDepsConfig HscEnvEq
env NormalizedFilePath
nfp
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unable to load file: " forall a. Semigroup a => a -> a -> a
<> String
fp) Maybe HscEnv
res

needsQuickCheck :: [(Section, Test)] -> Bool
needsQuickCheck :: [(Section, Test)] -> Bool
needsQuickCheck = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Test -> Bool
isProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

hasQuickCheck :: DynFlags -> Bool
hasQuickCheck :: DynFlags -> Bool
hasQuickCheck DynFlags
df = DynFlags -> String -> Bool
hasPackage DynFlags
df String
"QuickCheck"

singleLine :: String -> [Text]
singleLine :: String -> [Text]
singleLine String
s = [String -> Text
T.pack String
s]

{- |
 Convert error messages to a list of text lines
 Remove unnecessary information.
-}
errorLines :: String -> [Text]
errorLines :: String -> [Text]
errorLines =
        forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Text -> Bool
T.null
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"CallStack" Text -> Text -> Bool
`T.isPrefixOf`))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

{- |
 Convert exception messages to a list of text lines
 Remove unnecessary information and mark it as exception.
 We use '*** Exception:' to make it identical to doctest
 output, see #2353.
-}
exceptionLines :: String -> [Text]
exceptionLines :: String -> [Text]
exceptionLines = (forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
"*** Exception: " forall a. Semigroup a => a -> a -> a
<>)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Text]
errorLines

{- |
>>> map (pad_ (T.pack "--")) (map T.pack ["2+2",""])
["--2+2","--<BLANKLINE>"]
-}
pad_ :: Text -> Text -> Text
pad_ :: Text -> Text -> Text
pad_ Text
prefix = (Text
prefix Text -> Text -> Text
`T.append`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
convertBlank

convertBlank :: Text -> Text
convertBlank :: Text -> Text
convertBlank Text
x
    | Text -> Bool
T.null Text
x = Text
"<BLANKLINE>"
    | Bool
otherwise = Text
x

padPrefix :: IsString p => Format -> p
padPrefix :: forall p. IsString p => Format -> p
padPrefix Format
SingleLine = p
"-- "
padPrefix Format
_          = p
""

{- | Resulting @Text@ MUST NOT prefix each line with @--@
   Such comment-related post-process will be taken place
   solely in 'evalGhciLikeCmd'.
-}
type GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)

-- Should we use some sort of trie here?
ghciLikeCommands :: [(Text, GHCiLikeCmd)]
ghciLikeCommands :: [(Text, GHCiLikeCmd)]
ghciLikeCommands =
    [ (Text
"info", Bool -> GHCiLikeCmd
doInfoCmd Bool
False)
    , (Text
"info!", Bool -> GHCiLikeCmd
doInfoCmd Bool
True)
    , (Text
"kind", Bool -> GHCiLikeCmd
doKindCmd Bool
False)
    , (Text
"kind!", Bool -> GHCiLikeCmd
doKindCmd Bool
True)
    , (Text
"type", GHCiLikeCmd
doTypeCmd)
    ]

evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])
evalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])
evalGhciLikeCmd Text
cmd Text
arg = do
    DynFlags
df <- forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cmd [(Text, GHCiLikeCmd)]
ghciLikeCommands
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. (a, b) -> b
snd
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
T.isPrefixOf Text
cmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, GHCiLikeCmd)]
ghciLikeCommands of
        Just GHCiLikeCmd
hndler ->
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                Text -> [Text]
T.lines
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCiLikeCmd
hndler DynFlags
df Text
arg
        Maybe GHCiLikeCmd
_ -> forall a e. Exception e => e -> a
E.throw forall a b. (a -> b) -> a -> b
$ Text -> Text -> GhciLikeCmdException
GhciLikeCmdNotImplemented Text
cmd Text
arg

doInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)
doInfoCmd :: Bool -> GHCiLikeCmd
doInfoCmd Bool
allInfo DynFlags
dflags Text
s = do
    [SDoc]
sdocs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). GhcMonad m => Text -> m SDoc
infoThing (Text -> [Text]
T.words Text
s)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags ([SDoc] -> SDoc
vcat [SDoc]
sdocs)
    where
        infoThing :: GHC.GhcMonad m => Text -> m SDoc
        infoThing :: forall (m :: * -> *). GhcMonad m => Text -> m SDoc
infoThing (Text -> String
T.unpack -> String
str) = do
            [Name]
names     <- forall (m :: * -> *). GhcMonad m => String -> m [Name]
GHC.parseName String
str
            [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
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 = forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (\(TyThing
t,Fixity
_f,[ClsInst]
_ci,[FamInst]
_fi,SDoc
_sd) -> TyThing
t)
                                            (forall a. [Maybe a] -> [a]
catMaybes [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
mb_stuffs)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat (forall a. a -> [a] -> [a]
intersperse (String -> SDoc
text String
"") forall a b. (a -> b) -> a -> b
$ 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
            = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
has_parent) [a]
xs
            where
                all_names :: NameSet
all_names = [Name] -> NameSet
mkNameSet (forall a b. (a -> b) -> [a] -> [b]
map (forall a. NamedThing a => a -> Name
getName 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  -> 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
$$ TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
            SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstance [ClsInst]
cls_insts)
            SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst  [FamInst]
fam_insts)

        pprTyThingInContextLoc :: TyThing -> SDoc
        pprTyThingInContextLoc :: TyThing -> SDoc
pprTyThingInContextLoc TyThing
tyThing
            = SDoc -> SDoc -> SDoc
showWithLoc (Name -> SDoc
pprDefinedAt (forall a. NamedThing a => a -> Name
getName TyThing
tyThing))
                          (ShowSub -> TyThing -> SDoc
pprTyThingInContext ShowSub
showToHeader TyThing
tyThing)

        showWithLoc :: SDoc -> SDoc -> SDoc
        showWithLoc :: SDoc -> SDoc -> SDoc
showWithLoc SDoc
loc SDoc
doc
            = SDoc -> Int -> SDoc -> SDoc
hang SDoc
doc Int
2 (String -> SDoc
text String
"\t--" SDoc -> SDoc -> SDoc
<+> SDoc
loc)

        showFixity :: TyThing -> Fixity -> SDoc
        showFixity :: TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
            | Fixity
fixity forall a. Eq a => a -> a -> Bool
/= Fixity
GHC.defaultFixity Bool -> Bool -> Bool
|| OccName -> Bool
isSymOcc (forall a. NamedThing a => a -> OccName
getOccName TyThing
thing)
                = forall a. Outputable a => a -> SDoc
ppr Fixity
fixity SDoc -> SDoc -> SDoc
<+> forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName (forall a. NamedThing a => a -> Name
GHC.getName TyThing
thing)
            | Bool
otherwise = SDoc
empty

doKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)
doKindCmd :: Bool -> GHCiLikeCmd
doKindCmd Bool
False DynFlags
df Text
arg = do
    let input :: Text
input = Text -> Text
T.strip Text
arg
    (Type
_, Type
kind) <- forall (m :: * -> *).
GhcMonad m =>
Bool -> String -> m (Type, Type)
typeKind Bool
False forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
input
    let kindText :: SDoc
kindText = String -> SDoc
text (Text -> String
T.unpack Text
input) SDoc -> SDoc -> SDoc
<+> SDoc
"::" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
kind
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (DynFlags -> SDoc -> String
showSDoc DynFlags
df SDoc
kindText)
doKindCmd Bool
True DynFlags
df Text
arg = do
    let input :: Text
input = Text -> Text
T.strip Text
arg
    (Type
ty, Type
kind) <- forall (m :: * -> *).
GhcMonad m =>
Bool -> String -> m (Type, Type)
typeKind Bool
True forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
input
    let kindDoc :: SDoc
kindDoc = String -> SDoc
text (Text -> String
T.unpack Text
input) SDoc -> SDoc -> SDoc
<+> SDoc
"::" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
kind
        tyDoc :: SDoc
tyDoc = SDoc
"=" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
ty
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (DynFlags -> SDoc -> String
showSDoc DynFlags
df forall a b. (a -> b) -> a -> b
$ SDoc
kindDoc SDoc -> SDoc -> SDoc
$$ SDoc
tyDoc)

doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)
doTypeCmd :: GHCiLikeCmd
doTypeCmd DynFlags
dflags Text
arg = do
    let (TcRnExprMode
emod, Text
expr) = Text -> (TcRnExprMode, Text)
parseExprMode Text
arg
    Type
ty <- forall (m :: * -> *).
GhcMonad m =>
TcRnExprMode -> String -> m Type
GHC.exprType TcRnExprMode
emod forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
expr
    let rawType :: Text
rawType = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprTypeForUser Type
ty
        broken :: Bool
broken = (Char -> Bool) -> Text -> Bool
T.any (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
rawType
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            if Bool
broken
                then
                    String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                        DynFlags -> SDoc -> String
showSDoc DynFlags
dflags forall a b. (a -> b) -> a -> b
$
                            String -> SDoc
text (Text -> String
T.unpack Text
expr)
                                SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (SDoc
"::" SDoc -> SDoc -> SDoc
<+> Type -> SDoc
pprTypeForUser Type
ty)
                else Text
expr forall a. Semigroup a => a -> a -> a
<> Text
" :: " forall a. Semigroup a => a -> a -> a
<> Text
rawType forall a. Semigroup a => a -> a -> a
<> Text
"\n"

parseExprMode :: Text -> (TcRnExprMode, T.Text)
parseExprMode :: Text -> (TcRnExprMode, Text)
parseExprMode Text
rawArg = case (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace Text
rawArg of
#if !MIN_VERSION_ghc(9,2,0)
    ("+v", rest) -> (TM_NoInst, T.strip rest)
#endif
    (Text
"+d", Text
rest) -> (TcRnExprMode
TM_Default, Text -> Text
T.strip Text
rest)
    (Text, Text)
_            -> (TcRnExprMode
TM_Inst, Text
rawArg)

data GhciLikeCmdException = GhciLikeCmdNotImplemented
    { GhciLikeCmdException -> Text
ghciCmdName :: Text
    , GhciLikeCmdException -> Text
ghciCmdArg  :: Text
    }
    deriving (Typeable)

instance Show GhciLikeCmdException where
    showsPrec :: Int -> GhciLikeCmdException -> ShowS
showsPrec Int
_ GhciLikeCmdNotImplemented{Text
ghciCmdArg :: Text
ghciCmdName :: Text
$sel:ghciCmdArg:GhciLikeCmdNotImplemented :: GhciLikeCmdException -> Text
$sel:ghciCmdName:GhciLikeCmdNotImplemented :: GhciLikeCmdException -> Text
..} =
        String -> ShowS
showString String
"unknown command '"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Text -> String
T.unpack Text
ghciCmdName)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\''

instance E.Exception GhciLikeCmdException

{-
>>> parseGhciLikeCmd (T.pack ":kind! N + M + 1")
Just ("kind!","N + M + 1")
>>> parseGhciLikeCmd (T.pack ":kind a")
Just ("kind","a")
-}
parseGhciLikeCmd :: Text -> Maybe (Text, Text)
parseGhciLikeCmd :: Text -> Maybe (Text, Text)
parseGhciLikeCmd Text
input = do
    (Char
':', Text
rest) <- Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart Text
input
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace Text
rest

setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags
setupDynFlagsForGHCiLike HscEnv
env DynFlags
dflags = do
    let dflags3 :: DynFlags
dflags3 = DynFlags -> DynFlags
setInterpreterLinkerOptions DynFlags
dflags
        platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags3
        evalWays :: Ways
evalWays = Ways
Compat.hostFullWays
        dflags3a :: DynFlags
dflags3a = Ways -> DynFlags -> DynFlags
setWays Ways
evalWays DynFlags
dflags3
        dflags3b :: DynFlags
dflags3b =
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_set DynFlags
dflags3a forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
Compat.wayGeneralFlags Platform
platform) Ways
evalWays
        dflags3c :: DynFlags
dflags3c =
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
dflags3b forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Platform -> Way -> [GeneralFlag]
Compat.wayUnsetGeneralFlags Platform
platform) Ways
evalWays
        dflags4 :: DynFlags
dflags4 =
            DynFlags
dflags3c
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreOptimChanges
                DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_IgnoreHpcChanges
                DynFlags -> GeneralFlag -> DynFlags
`gopt_unset` GeneralFlag
Opt_DiagnosticsShowCaret
    HscEnv -> DynFlags
Compat.hsc_dflags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> IO HscEnv
Compat.initializePlugins (DynFlags -> HscEnv -> HscEnv
Compat.hscSetFlags DynFlags
dflags4 HscEnv
env)