{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DuplicateRecordFields     #-}
{-# LANGUAGE ExtendedDefaultRules      #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ViewPatterns              #-}
{-# OPTIONS_GHC -fno-warn-type-defaults -Wno-unused-imports #-}

{- |
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                            (bracket_, 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.Except                   (ExceptT (..),
                                                               runExceptT)
import           Data.Aeson                                   (toJSON)
import           Data.Char                                    (isSpace)
import           Data.Foldable                                (toList)
import           Data.List                                    (dropWhileEnd,
                                                               find,
                                                               intercalate,
                                                               intersperse)
import qualified Data.Map                                     as Map
import           Data.Maybe                                   (catMaybes)
import           Data.String                                  (IsString)
import           Data.Text                                    (Text)
import qualified Data.Text                                    as T
import           Data.Typeable                                (Typeable)
import           Development.IDE.Core.Rules                   (IdeState,
                                                               runAction)
import           Development.IDE.Core.RuleTypes               (LinkableResult (linkableHomeMod),
                                                               NeedsCompilation (NeedsCompilation),
                                                               TypeCheck (..),
                                                               tmrTypechecked)
import           Development.IDE.Core.Shake                   (shakeExtras,
                                                               useNoFile_,
                                                               useWithStale_,
                                                               use_, uses_)
import           Development.IDE.GHC.Compat                   hiding (typeKind,
                                                               unitState)
import           Development.IDE.GHC.Compat.Util              (GhcException,
                                                               OverridingBool (..),
                                                               bagToList)
import           Development.IDE.GHC.Util                     (evalGhcEnv,
                                                               modifyDynFlags,
                                                               printOutputable)
import           Development.IDE.Import.DependencyInformation (transitiveDeps,
                                                               transitiveModuleDeps)
import           Development.IDE.Types.Location               (toNormalizedFilePath',
                                                               uriToFilePath')
import           GHC                                          (ClsInst,
                                                               ExecOptions (execLineNumber, execSourceFile),
                                                               FamInst,
                                                               GhcMonad,
                                                               NamedThing (getName),
                                                               defaultFixity,
                                                               execOptions,
                                                               exprType,
                                                               getInfo,
                                                               getInteractiveDynFlags,
                                                               isImport, isStmt,
                                                               parseName,
                                                               pprFamInst,
                                                               pprInstance,
                                                               typeKind)


import           Development.IDE.Core.RuleTypes               (GetLinkable (GetLinkable),
                                                               GetModSummary (GetModSummary),
                                                               GetModuleGraph (GetModuleGraph),
                                                               GhcSessionDeps (GhcSessionDeps),
                                                               ModSummaryResult (msrModSummary))
import           Development.IDE.Core.Shake                   (VFSModified (VFSUnmodified))
import qualified Development.IDE.GHC.Compat.Core              as Compat (InteractiveImport (IIModule))
import qualified Development.IDE.GHC.Compat.Core              as SrcLoc (HasSrcSpan (getLoc),
                                                                         unLoc)
import           Development.IDE.Types.HscEnvEq               (HscEnvEq (hscEnv))
import qualified GHC.LanguageExtensions.Type                  as LangExt (Extension (..))

import           Control.Concurrent.STM.Stats                 (atomically)
import           Development.IDE.Core.FileStore               (setSomethingModified)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Graph                        (ShakeOptions (shakeExtra))
import           Development.IDE.Types.Shake                  (toKey)
import           GHC.Types.SrcLoc                             (UnhelpfulSpanReason (UnhelpfulInteractive))
import           Ide.Logger                                   (Priority (..),
                                                               Recorder,
                                                               WithPriority,
                                                               logWith)
import           Ide.Plugin.Error                             (PluginError (PluginInternalError),
                                                               handleMaybe,
                                                               handleMaybeM)
import           Ide.Plugin.Eval.Code                         (Statement,
                                                               asStatements,
                                                               myExecStmt,
                                                               propSetup,
                                                               resultRange,
                                                               testCheck,
                                                               testRanges)
import           Ide.Plugin.Eval.Config                       (EvalConfig (..),
                                                               getEvalConfig)
import           Ide.Plugin.Eval.GHC                          (addImport,
                                                               addPackages,
                                                               hasPackage,
                                                               setSessionAndInteractiveDynFlags,
                                                               showDynFlags)
import           Ide.Plugin.Eval.Parse.Comments               (commentsToSections)
import           Ide.Plugin.Eval.Parse.Option                 (parseSetFlags)
import           Ide.Plugin.Eval.Rules                        (queueForEvaluation,
                                                               unqueueForEvaluation)
import           Ide.Plugin.Eval.Types
import           Ide.Plugin.Eval.Util                         (gStrictTry,
                                                               isLiterate,
                                                               prettyWarnings,
                                                               response', timed)
import           Ide.Types
import qualified Language.LSP.Protocol.Lens                   as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Language.LSP.Server
import           Language.LSP.VFS                             (virtualFileText)

{- | Code Lens provider
 NOTE: Invoked every time the document is modified, not just when the document is saved.
-}
codeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens
codeLens :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
codeLens Recorder (WithPriority Log)
recorder IdeState
st PluginId
plId CodeLensParams{TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument} =
    let dbg :: Log -> m ()
dbg = Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug
        perf :: Text -> m b -> m b
perf = (Text -> Seconds -> m ()) -> Text -> m b -> m b
forall (m :: * -> *) t a b.
MonadIO m =>
(t -> Seconds -> m a) -> t -> m b -> m b
timed (\Text
lbl Seconds
duration -> Log -> m ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Seconds -> Log
LogExecutionTime Text
lbl Seconds
duration)
     in Text
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentCodeLens)
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentCodeLens)
forall {m :: * -> *} {b}. MonadIO m => Text -> m b -> m b
perf Text
"codeLens" (ExceptT
   PluginError
   (HandlerM Config)
   (MessageResult 'Method_TextDocumentCodeLens)
 -> ExceptT
      PluginError
      (HandlerM Config)
      (MessageResult 'Method_TextDocumentCodeLens))
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentCodeLens)
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentCodeLens)
forall a b. (a -> b) -> a -> b
$
            do
                let TextDocumentIdentifier Uri
uri = TextDocumentIdentifier
_textDocument
                FilePath
fp <- Uri -> ExceptT PluginError (HandlerM Config) FilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m FilePath
uriToFilePathE Uri
uri
                let nfp :: NormalizedFilePath
nfp = FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
fp
                    isLHS :: Bool
isLHS = FilePath -> Bool
isLiterate FilePath
fp
                Log -> ExceptT PluginError (HandlerM Config) ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> ExceptT PluginError (HandlerM Config) ())
-> Log -> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Log
LogCodeLensFp FilePath
fp
                (Comments
comments, PositionMapping
_) <-
                    FilePath
-> IdeState
-> ExceptT PluginError Action (Comments, PositionMapping)
-> ExceptT
     PluginError (HandlerM Config) (Comments, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
FilePath -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE FilePath
"eval.GetParsedModuleWithComments" IdeState
st (ExceptT PluginError Action (Comments, PositionMapping)
 -> ExceptT
      PluginError (HandlerM Config) (Comments, PositionMapping))
-> ExceptT PluginError Action (Comments, PositionMapping)
-> ExceptT
     PluginError (HandlerM Config) (Comments, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GetEvalComments
-> NormalizedFilePath
-> ExceptT PluginError Action (Comments, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE 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
                Log -> ExceptT PluginError (HandlerM Config) ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> ExceptT PluginError (HandlerM Config) ())
-> Log -> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ Comments -> Log
LogCodeLensComments Comments
comments

                -- Extract tests from source code
                let Sections{[Section]
nonSetupSections :: [Section]
setupSections :: [Section]
$sel:nonSetupSections:Sections :: Sections -> [Section]
$sel:setupSections:Sections :: Sections -> [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=..." ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [])
                let lenses :: [CodeLens]
lenses =
                        [ Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
testRange (Command -> Maybe Command
forall a. a -> Maybe a
Just Command
cmd') Maybe Value
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 [Section] -> [Section] -> [Section]
forall a. [a] -> [a] -> [a]
++ [Section
section]) TextDocumentIdentifier
_textDocument Int
ident
                              cmd' :: Command
cmd' =
                                (Command
cmd :: Command)
                                    { _arguments = Just [toJSON args]
                                    , _title =
                                        if trivial resultRange
                                            then "Evaluate..."
                                            else "Refresh..."
                                    }
                        ]

                Text
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall {m :: * -> *} {b}. MonadIO m => Text -> m b -> m b
perf Text
"tests" (ExceptT PluginError (HandlerM Config) ()
 -> ExceptT PluginError (HandlerM Config) ())
-> ExceptT PluginError (HandlerM Config) ()
-> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$
                    Log -> ExceptT PluginError (HandlerM Config) ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> ExceptT PluginError (HandlerM Config) ())
-> Log -> ExceptT PluginError (HandlerM Config) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Log
LogTests
                            ([(Section, Int, Test)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Section, Int, Test)]
tests)
                            ([Section] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Section]
nonSetupSections)
                            ([Section] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Section]
setupSections)
                            ([CodeLens] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeLens]
lenses)

                ([CodeLens] |? Null)
-> ExceptT PluginError (HandlerM Config) ([CodeLens] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([CodeLens] |? Null)
 -> ExceptT PluginError (HandlerM Config) ([CodeLens] |? Null))
-> ([CodeLens] |? Null)
-> ExceptT PluginError (HandlerM Config) ([CodeLens] |? Null)
forall a b. (a -> b) -> a -> b
$ [CodeLens] -> [CodeLens] |? Null
forall a b. a -> a |? b
InL [CodeLens]
lenses
  where
    trivial :: Range -> Bool
trivial (Range Position
p Position
p') = Position
p Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
p'

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

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

type EvalId = Int

runEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams
runEvalCmd :: Recorder (WithPriority Log)
-> PluginId -> CommandFunction IdeState EvalParams
runEvalCmd Recorder (WithPriority Log)
recorder PluginId
plId IdeState
st Maybe ProgressToken
mtoken EvalParams{Int
[Section]
TextDocumentIdentifier
sections :: [Section]
module_ :: TextDocumentIdentifier
evalId :: Int
$sel:sections:EvalParams :: EvalParams -> [Section]
$sel:module_:EvalParams :: EvalParams -> TextDocumentIdentifier
$sel:evalId:EvalParams :: EvalParams -> Int
..} =
    let dbg :: Log -> m ()
dbg = Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug
        perf :: Text -> m b -> m b
perf = (Text -> Seconds -> m ()) -> Text -> m b -> m b
forall (m :: * -> *) t a b.
MonadIO m =>
(t -> Seconds -> m a) -> t -> m b -> m b
timed (\Text
lbl Seconds
duration -> Log -> m ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> m ()) -> Log -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Seconds -> Log
LogExecutionTime Text
lbl Seconds
duration)
        cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit
        cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit
cmd = do
            let tests :: [(Section, Test)]
tests = ((Section, Int, Test) -> (Section, Test))
-> [(Section, Int, Test)] -> [(Section, Test)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Section
a,Int
_,Test
b) -> (Section
a,Test
b)) ([(Section, Int, Test)] -> [(Section, Test)])
-> [(Section, Int, Test)] -> [(Section, Test)]
forall a b. (a -> b) -> a -> b
$ [Section] -> [(Section, Int, Test)]
testsBySection [Section]
sections

            let TextDocumentIdentifier{Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri} = TextDocumentIdentifier
module_
            FilePath
fp <- Uri -> ExceptT PluginError (HandlerM Config) FilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m FilePath
uriToFilePathE Uri
_uri
            let nfp :: NormalizedFilePath
nfp = FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
fp
            Text
mdlText <- Uri -> ExceptT PluginError (HandlerM Config) Text
forall config. Uri -> ExceptT PluginError (HandlerM config) Text
moduleText Uri
_uri

            -- enable codegen for the module which we need to evaluate.
            HscEnv
final_hscEnv <- IO HscEnv -> ExceptT PluginError (HandlerM Config) HscEnv
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> ExceptT PluginError (HandlerM Config) HscEnv)
-> IO HscEnv -> ExceptT PluginError (HandlerM Config) HscEnv
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO HscEnv -> IO HscEnv
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
              (VFSModified -> IdeState -> FilePath -> IO [Key] -> IO ()
setSomethingModified VFSModified
VFSUnmodified IdeState
st FilePath
"Eval" (IO [Key] -> IO ()) -> IO [Key] -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                IdeState -> NormalizedFilePath -> IO ()
queueForEvaluation IdeState
st NormalizedFilePath
nfp
                [Key] -> IO [Key]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IsEvaluating -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey IsEvaluating
IsEvaluating NormalizedFilePath
nfp]
                )
              (VFSModified -> IdeState -> FilePath -> IO [Key] -> IO ()
setSomethingModified VFSModified
VFSUnmodified IdeState
st FilePath
"Eval" (IO [Key] -> IO ()) -> IO [Key] -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                IdeState -> NormalizedFilePath -> IO ()
unqueueForEvaluation IdeState
st NormalizedFilePath
nfp
                [Key] -> IO [Key]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IsEvaluating -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey IsEvaluating
IsEvaluating NormalizedFilePath
nfp]
                )
              (Bool -> IdeState -> NormalizedFilePath -> IO HscEnv
initialiseSessionForEval ([(Section, Test)] -> Bool
needsQuickCheck [(Section, Test)]
tests) IdeState
st NormalizedFilePath
nfp)

            EvalConfig
evalCfg <- IO EvalConfig -> ExceptT PluginError (HandlerM Config) EvalConfig
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EvalConfig -> ExceptT PluginError (HandlerM Config) EvalConfig)
-> IO EvalConfig
-> ExceptT PluginError (HandlerM Config) EvalConfig
forall a b. (a -> b) -> a -> b
$ FilePath -> IdeState -> Action EvalConfig -> IO EvalConfig
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"eval: config" IdeState
st (Action EvalConfig -> IO EvalConfig)
-> Action EvalConfig -> IO EvalConfig
forall a b. (a -> b) -> a -> b
$ PluginId -> Action EvalConfig
getEvalConfig PluginId
plId

            -- Perform the evaluation of the command
            [TextEdit]
edits <-
                Text
-> ExceptT PluginError (HandlerM Config) [TextEdit]
-> ExceptT PluginError (HandlerM Config) [TextEdit]
forall {m :: * -> *} {b}. MonadIO m => Text -> m b -> m b
perf Text
"edits" (ExceptT PluginError (HandlerM Config) [TextEdit]
 -> ExceptT PluginError (HandlerM Config) [TextEdit])
-> ExceptT PluginError (HandlerM Config) [TextEdit]
-> ExceptT PluginError (HandlerM Config) [TextEdit]
forall a b. (a -> b) -> a -> b
$
                    IO [TextEdit] -> ExceptT PluginError (HandlerM Config) [TextEdit]
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TextEdit] -> ExceptT PluginError (HandlerM Config) [TextEdit])
-> IO [TextEdit]
-> ExceptT PluginError (HandlerM Config) [TextEdit]
forall a b. (a -> b) -> a -> b
$
                        HscEnv -> Ghc [TextEdit] -> IO [TextEdit]
forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
final_hscEnv (Ghc [TextEdit] -> IO [TextEdit])
-> Ghc [TextEdit] -> IO [TextEdit]
forall a b. (a -> b) -> a -> b
$ do
                            Recorder (WithPriority Log)
-> EvalConfig -> FilePath -> [(Section, Test)] -> Ghc [TextEdit]
runTests Recorder (WithPriority Log)
recorder EvalConfig
evalCfg FilePath
fp [(Section, Test)]
tests

            let workspaceEditsMap :: Map Uri [TextEdit]
workspaceEditsMap = Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton Uri
_uri (Text -> [TextEdit] -> [TextEdit]
addFinalReturn Text
mdlText [TextEdit]
edits)
            let workspaceEdits :: WorkspaceEdit
workspaceEdits = Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just Map Uri [TextEdit]
workspaceEditsMap) Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing

            WorkspaceEdit
-> ExceptT PluginError (HandlerM Config) WorkspaceEdit
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceEdit
workspaceEdits
     in Text
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall {m :: * -> *} {b}. MonadIO m => Text -> m b -> m b
perf Text
"evalCmd" (ExceptT PluginError (HandlerM Config) (Value |? Null)
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (HandlerM Config (Either PluginError (Value |? Null))
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> HandlerM Config (Either PluginError (Value |? Null))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$
            Text
-> Maybe ProgressToken
-> ProgressCancellable
-> ((Text -> HandlerM Config ())
    -> HandlerM Config (Either PluginError (Value |? Null)))
-> HandlerM Config (Either PluginError (Value |? Null))
forall config a.
Text
-> Maybe ProgressToken
-> ProgressCancellable
-> ((Text -> HandlerM config ()) -> HandlerM config a)
-> HandlerM config a
pluginWithIndefiniteProgress Text
"Evaluating" Maybe ProgressToken
mtoken ProgressCancellable
Cancellable (((Text -> HandlerM Config ())
  -> HandlerM Config (Either PluginError (Value |? Null)))
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> ((Text -> HandlerM Config ())
    -> HandlerM Config (Either PluginError (Value |? Null)))
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ \Text -> HandlerM Config ()
_updater ->
                ExceptT PluginError (HandlerM Config) (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PluginError (HandlerM Config) (Value |? Null)
 -> HandlerM Config (Either PluginError (Value |? Null)))
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ ExceptT PluginError (HandlerM Config) WorkspaceEdit
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall c.
ExceptT PluginError (HandlerM c) WorkspaceEdit
-> ExceptT PluginError (HandlerM c) (Value |? Null)
response' ExceptT PluginError (HandlerM Config) WorkspaceEdit
cmd

-- | Create an HscEnv which is suitable for performing interactive evaluation.
-- All necessary home modules will have linkables and the current module will
-- also be loaded into the environment.
--
-- The interactive context and interactive dynamic flags are also set appropiately.
initialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv
initialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv
initialiseSessionForEval Bool
needs_quickcheck IdeState
st NormalizedFilePath
nfp = do
  (ModSummary
ms, HscEnv
env1) <- FilePath
-> IdeState
-> Action (ModSummary, HscEnv)
-> IO (ModSummary, HscEnv)
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"runEvalCmd" IdeState
st (Action (ModSummary, HscEnv) -> IO (ModSummary, HscEnv))
-> Action (ModSummary, HscEnv) -> IO (ModSummary, HscEnv)
forall a b. (a -> b) -> a -> b
$ do

    ModSummary
ms <- ModSummaryResult -> ModSummary
msrModSummary (ModSummaryResult -> ModSummary)
-> Action ModSummaryResult -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
nfp
    HscEnv
deps_hsc <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
nfp

    Maybe TransitiveDependencies
linkables_needed <- DependencyInformation
-> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps (DependencyInformation
 -> NormalizedFilePath -> Maybe TransitiveDependencies)
-> Action DependencyInformation
-> Action (NormalizedFilePath -> Maybe TransitiveDependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModuleGraph -> Action DependencyInformation
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetModuleGraph
GetModuleGraph Action (NormalizedFilePath -> Maybe TransitiveDependencies)
-> Action NormalizedFilePath
-> Action (Maybe TransitiveDependencies)
forall a b. Action (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NormalizedFilePath -> Action NormalizedFilePath
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NormalizedFilePath
nfp
    [LinkableResult]
linkables <- GetLinkable -> [NormalizedFilePath] -> Action [LinkableResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetLinkable
GetLinkable (NormalizedFilePath
nfp NormalizedFilePath -> [NormalizedFilePath] -> [NormalizedFilePath]
forall a. a -> [a] -> [a]
: [NormalizedFilePath]
-> (TransitiveDependencies -> [NormalizedFilePath])
-> Maybe TransitiveDependencies
-> [NormalizedFilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps Maybe TransitiveDependencies
linkables_needed)
    -- We unset the global rdr env in mi_globals when we generate interfaces
    -- See Note [Clearing mi_globals after generating an iface]
    -- However, the eval plugin (setContext specifically) requires the rdr_env
    -- for the current module - so get it from the Typechecked Module and add
    -- it back to the iface for the current module.
    GlobalRdrEnv
rdr_env <- TcGblEnv -> GlobalRdrEnv
tcg_rdr_env (TcGblEnv -> GlobalRdrEnv)
-> (TcModuleResult -> TcGblEnv) -> TcModuleResult -> GlobalRdrEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcModuleResult -> TcGblEnv
tmrTypechecked (TcModuleResult -> GlobalRdrEnv)
-> Action TcModuleResult -> Action GlobalRdrEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeCheck -> NormalizedFilePath -> Action TcModuleResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ TypeCheck
TypeCheck NormalizedFilePath
nfp
    let linkable_hsc :: HscEnv
linkable_hsc = [HomeModInfo] -> HscEnv -> HscEnv
loadModulesHome ((LinkableResult -> HomeModInfo)
-> [LinkableResult] -> [HomeModInfo]
forall a b. (a -> b) -> [a] -> [b]
map (HomeModInfo -> HomeModInfo
addRdrEnv (HomeModInfo -> HomeModInfo)
-> (LinkableResult -> HomeModInfo) -> LinkableResult -> HomeModInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkableResult -> HomeModInfo
linkableHomeMod) [LinkableResult]
linkables) HscEnv
deps_hsc
        addRdrEnv :: HomeModInfo -> HomeModInfo
addRdrEnv HomeModInfo
hmi
          | ModIface
iface <- HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi
          , ModSummary -> Module
ms_mod ModSummary
ms Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
          = HomeModInfo
hmi { hm_iface = iface { mi_globals = Just $!
#if MIN_VERSION_ghc(9,8,0)
                    forceGlobalRdrEnv
#endif
                      rdr_env
                }}
          | Bool
otherwise = HomeModInfo
hmi

    (ModSummary, HscEnv) -> Action (ModSummary, HscEnv)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary
ms, HscEnv
linkable_hsc)
  -- Bit awkward we need to use evalGhcEnv here but setContext requires to run
  -- in the Ghc monad
  HscEnv
env2 <- IO HscEnv -> IO HscEnv
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> IO HscEnv) -> IO HscEnv -> IO HscEnv
forall a b. (a -> b) -> a -> b
$ HscEnv -> Ghc HscEnv -> IO HscEnv
forall b. HscEnv -> Ghc b -> IO b
evalGhcEnv HscEnv
env1 (Ghc HscEnv -> IO HscEnv) -> Ghc HscEnv -> IO HscEnv
forall a b. (a -> b) -> a -> b
$ do
            [InteractiveImport] -> Ghc ()
forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
setContext [ModuleName -> InteractiveImport
Compat.IIModule (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
ms))]
            let df :: DynFlags
df = (DynFlags -> Extension -> DynFlags)
-> Extension -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> Extension -> DynFlags
xopt_set    Extension
LangExt.ExtendedDefaultRules
                   (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DynFlags -> Extension -> DynFlags)
-> Extension -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> Extension -> DynFlags
xopt_unset  Extension
LangExt.MonomorphismRestriction
                   (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set    GeneralFlag
Opt_ImplicitImportQualified
                   (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset  GeneralFlag
Opt_DiagnosticsShowCaret
                   (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backend -> DynFlags -> DynFlags
setBackend Backend
ghciBackend
                   (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms) {
                        useColor = Never
                      , canUseColor = False }
            (DynFlags -> DynFlags) -> Ghc ()
forall (m :: * -> *). GhcMonad m => (DynFlags -> DynFlags) -> m ()
modifyDynFlags (DynFlags -> DynFlags -> DynFlags
forall a b. a -> b -> a
const DynFlags
df)
            Bool -> Ghc () -> Ghc ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needs_quickcheck (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Ghc (Either FilePath DynFlags) -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc (Either FilePath DynFlags) -> Ghc ())
-> Ghc (Either FilePath DynFlags) -> Ghc ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Ghc (Either FilePath DynFlags)
addPackages [FilePath
"QuickCheck"]
            Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  HscEnv -> IO HscEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HscEnv
env2

addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
addFinalReturn :: Text -> [TextEdit] -> [TextEdit]
addFinalReturn Text
mdlText [TextEdit]
edits
    | Bool -> Bool
not ([TextEdit] -> Bool
forall a. [a] -> Bool
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
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
mdlText Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' =
        Text -> TextEdit
finalReturn Text
mdlText TextEdit -> [TextEdit] -> [TextEdit]
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 = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
        c :: b
c = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> ([Text] -> Text) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. HasCallStack => [a] -> a
last ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ [Text]
ls
        p :: Position
p = UInt -> UInt -> Position
Position UInt
forall {b}. Num b => b
l UInt
forall {b}. Num b => b
c
     in Range -> Text -> TextEdit
TextEdit (Position -> Position -> Range
Range Position
p Position
p) Text
"\n"

moduleText :: Uri -> ExceptT PluginError (HandlerM config) Text
moduleText :: forall config. Uri -> ExceptT PluginError (HandlerM config) Text
moduleText Uri
uri =
    PluginError
-> HandlerM config (Maybe Text)
-> ExceptT PluginError (HandlerM config) Text
forall (m :: * -> *) e b.
Monad m =>
e -> m (Maybe b) -> ExceptT e m b
handleMaybeM (Text -> PluginError
PluginInternalError Text
"mdlText") (HandlerM config (Maybe Text)
 -> ExceptT PluginError (HandlerM config) Text)
-> HandlerM config (Maybe Text)
-> ExceptT PluginError (HandlerM config) Text
forall a b. (a -> b) -> a -> b
$
      (VirtualFile -> Text
virtualFileText <$>)
          (Maybe VirtualFile -> Maybe Text)
-> HandlerM config (Maybe VirtualFile)
-> HandlerM config (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NormalizedUri -> HandlerM config (Maybe VirtualFile)
forall config. NormalizedUri -> HandlerM config (Maybe VirtualFile)
pluginGetVirtualFile
              (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) <- [Int] -> [Section] -> [(Int, Section)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Section]
sections
    , Test
test <- Section -> [Test]
sectionTests Section
section
    ]

type TEnv = String
-- |GHC declarations required for expression evaluation
evalSetup :: Ghc ()
evalSetup :: Ghc ()
evalSetup = do
    ImportDecl GhcPs
preludeAsP <- FilePath -> Ghc (ImportDecl GhcPs)
forall (m :: * -> *).
GhcMonad m =>
FilePath -> m (ImportDecl GhcPs)
parseImportDecl FilePath
"import qualified Prelude as P"
    [InteractiveImport]
context <- Ghc [InteractiveImport]
forall (m :: * -> *). GhcMonad m => m [InteractiveImport]
getContext
    [InteractiveImport] -> Ghc ()
forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
setContext (ImportDecl GhcPs -> InteractiveImport
IIDecl ImportDecl GhcPs
preludeAsP InteractiveImport -> [InteractiveImport] -> [InteractiveImport]
forall a. a -> [a] -> [a]
: [InteractiveImport]
context)

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

    ((Section, Test) -> Ghc TextEdit)
-> [(Section, Test)] -> Ghc [TextEdit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> DynFlags -> (Section, Test) -> Ghc TextEdit
processTest FilePath
e DynFlags
df) [(Section, Test)]
tests
  where
    processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit
    processTest :: FilePath -> DynFlags -> (Section, Test) -> Ghc TextEdit
processTest FilePath
fp DynFlags
df (Section
section, Test
test) = do
        let dbg :: Log -> m ()
dbg = Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug
        let pad :: Text -> Text
pad = Text -> Text -> Text
pad_ (Text -> Text -> Text) -> Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (if FilePath -> Bool
isLiterate FilePath
fp then (Text
"> " `T.append`) else Text -> Text
forall a. a -> a
id) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Format -> Text
forall p. IsString p => Format -> p
padPrefix (Section -> Format
sectionFormat Section
section)
        [Text]
rs <- FilePath -> DynFlags -> Test -> Ghc [Text]
runTest FilePath
e DynFlags
df Test
test
        Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Log
LogRunTestResults [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 = (Text -> [Text]) -> [Text] -> [Text]
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 ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
pad [Text]
resultLines)
        Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ TextEdit -> Log
LogRunTestEdits TextEdit
edit
        TextEdit -> Ghc TextEdit
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return TextEdit
edit

    -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]
    runTest :: FilePath -> DynFlags -> Test -> Ghc [Text]
runTest FilePath
_ DynFlags
df Test
test
        | Bool -> Bool
not (DynFlags -> Bool
hasQuickCheck DynFlags
df) Bool -> Bool -> Bool
&& Test -> Bool
isProperty Test
test =
            [Text] -> Ghc [Text]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Ghc [Text]) -> [Text] -> Ghc [Text]
forall a b. (a -> b) -> a -> b
$
                FilePath -> [Text]
singleLine
                    FilePath
"Add QuickCheck to your cabal dependencies to run this test."
    runTest FilePath
e DynFlags
df Test
test = Recorder (WithPriority Log)
-> Bool -> FilePath -> DynFlags -> [Statement] -> Ghc [Text]
evals Recorder (WithPriority Log)
recorder (Bool
eval_cfg_exception Bool -> Bool -> Bool
&& Bool -> Bool
not (Test -> Bool
isProperty Test
test)) FilePath
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 Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
L.end ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
L.line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== Range
commRange Range -> Getting UInt Range UInt -> UInt
forall s a. s -> Getting a s a -> a
^. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
L.end ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> Getting UInt Range UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
L.line
    =
    Range -> Text -> TextEdit
TextEdit
        (Position -> Position -> Range
Range
            (Test -> Range
testRange Test
test Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
L.end)
            (Test -> Range
resultRange Test
test Range -> Getting Position Range Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position Range Position
forall s a. HasEnd s a => Lens' s a
Lens' Range Position
L.end)
        )
        (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines ([Text]
resultLines [Text] -> [Text] -> [Text]
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 :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
evals :: Recorder (WithPriority Log)
-> Bool -> FilePath -> DynFlags -> [Statement] -> Ghc [Text]
evals Recorder (WithPriority Log)
recorder Bool
mark_exception FilePath
fp DynFlags
df [Statement]
stmts = do
    Either FilePath [Maybe [Text]]
er <- Ghc [Maybe [Text]] -> Ghc (Either FilePath [Maybe [Text]])
forall (m :: * -> *) b.
(MonadIO m, MonadCatch m) =>
m b -> m (Either FilePath b)
gStrictTry (Ghc [Maybe [Text]] -> Ghc (Either FilePath [Maybe [Text]]))
-> Ghc [Maybe [Text]] -> Ghc (Either FilePath [Maybe [Text]])
forall a b. (a -> b) -> a -> b
$ (Statement -> Ghc (Maybe [Text]))
-> [Statement] -> Ghc [Maybe [Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Statement -> Ghc (Maybe [Text])
eval [Statement]
stmts
    [Text] -> Ghc [Text]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Ghc [Text]) -> [Text] -> Ghc [Text]
forall a b. (a -> b) -> a -> b
$ case Either FilePath [Maybe [Text]]
er of
        Left FilePath
err -> FilePath -> [Text]
errorLines FilePath
err
        Right [Maybe [Text]]
rs -> [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text])
-> ([Maybe [Text]] -> [[Text]]) -> [Maybe [Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Text]] -> [[Text]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Text]] -> [Text]) -> [Maybe [Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe [Text]]
rs
  where
    dbg :: Log -> m ()
dbg = Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug
    eval :: Statement -> Ghc (Maybe [Text])
    eval :: Statement -> Ghc (Maybe [Text])
eval (Located Int
l FilePath
stmt)
        | -- GHCi flags
          Just (FilePath -> [FilePath]
words -> [FilePath]
flags) <- FilePath -> Maybe FilePath
parseSetFlags FilePath
stmt = do
            Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Log
LogEvalFlags [FilePath]
flags
            DynFlags
ndf <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getInteractiveDynFlags
            Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Log
LogEvalPreSetDynFlags DynFlags
ndf
            Either GhcException (DynFlags, [Located FilePath], [Warn])
eans <-
                IO (Either GhcException (DynFlags, [Located FilePath], [Warn]))
-> Ghc (Either GhcException (DynFlags, [Located FilePath], [Warn]))
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either GhcException (DynFlags, [Located FilePath], [Warn]))
 -> Ghc
      (Either GhcException (DynFlags, [Located FilePath], [Warn])))
-> IO (Either GhcException (DynFlags, [Located FilePath], [Warn]))
-> Ghc (Either GhcException (DynFlags, [Located FilePath], [Warn]))
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @GhcException (IO (DynFlags, [Located FilePath], [Warn])
 -> IO (Either GhcException (DynFlags, [Located FilePath], [Warn])))
-> IO (DynFlags, [Located FilePath], [Warn])
-> IO (Either GhcException (DynFlags, [Located FilePath], [Warn]))
forall a b. (a -> b) -> a -> b
$
                DynFlags
-> [Located FilePath] -> IO (DynFlags, [Located FilePath], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
parseDynamicFlagsCmdLine DynFlags
ndf
                ((FilePath -> Located FilePath) -> [FilePath] -> [Located FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> FilePath -> Located FilePath
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> FilePath -> Located FilePath)
-> SrcSpan -> FilePath -> Located FilePath
forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
unhelpfulReason) [FilePath]
flags)
            Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Either GhcException (DynFlags, [Located FilePath], [Warn]) -> Log
LogEvalParsedFlags Either GhcException (DynFlags, [Located FilePath], [Warn])
eans
            case Either GhcException (DynFlags, [Located FilePath], [Warn])
eans of
                Left GhcException
err -> Maybe [Text] -> Ghc (Maybe [Text])
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Text] -> Ghc (Maybe [Text]))
-> Maybe [Text] -> Ghc (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text]
errorLines (FilePath -> [Text]) -> FilePath -> [Text]
forall a b. (a -> b) -> a -> b
$ GhcException -> FilePath
forall a. Show a => a -> FilePath
show GhcException
err
                Right (DynFlags
df', [Located FilePath]
ignoreds, [Warn]
warns) -> do
                    let warnings :: m [Text]
warnings = do
                            Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Warn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Warn]
warns
                            [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text]
errorLines (FilePath -> [Text]) -> FilePath -> [Text]
forall a b. (a -> b) -> a -> b
$
                                [Warn] -> FilePath
prettyWarnings [Warn]
warns
                        igns :: m [Text]
igns = do
                            Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Located FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located FilePath]
ignoreds
                            [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                [Text
"Some flags have not been recognized: "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (Located FilePath -> FilePath) -> [Located FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Located FilePath -> FilePath
forall l e. GenLocated l e -> e
SrcLoc.unLoc [Located FilePath]
ignoreds)
                                ]
                    Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Log
LogEvalPostSetDynFlags DynFlags
df'
                    DynFlags -> Ghc ()
setSessionAndInteractiveDynFlags DynFlags
df'
                    Maybe [Text] -> Ghc (Maybe [Text])
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Text] -> Ghc (Maybe [Text]))
-> Maybe [Text] -> Ghc (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ Maybe [Text]
forall {m :: * -> *}. (Monad m, Alternative m) => m [Text]
warnings Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Semigroup a => a -> a -> a
<> Maybe [Text]
forall {m :: * -> *}. (Monad m, Alternative m) => m [Text]
igns
        | -- A type/kind command
          Just (Text
cmd, Text
arg) <- Text -> Maybe (Text, Text)
parseGhciLikeCmd (Text -> Maybe (Text, Text)) -> Text -> Maybe (Text, Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
stmt =
            Text -> Text -> Ghc (Maybe [Text])
evalGhciLikeCmd Text
cmd Text
arg
        | -- A statement
          ParserOpts -> FilePath -> Bool
isStmt ParserOpts
pf FilePath
stmt =
            do
                Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Log
LogEvalStmtStart FilePath
stmt
                Either FilePath (Maybe FilePath)
res <- FilePath -> Int -> Ghc (Either FilePath (Maybe FilePath))
exec FilePath
stmt Int
l
                let r :: Maybe [Text]
r = case Either FilePath (Maybe FilePath)
res of
                        Left FilePath
err -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> (FilePath -> [Text]) -> FilePath -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
mark_exception then FilePath -> [Text]
exceptionLines else FilePath -> [Text]
errorLines) (FilePath -> Maybe [Text]) -> FilePath -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ FilePath
err
                        Right Maybe FilePath
x  -> FilePath -> [Text]
singleLine (FilePath -> [Text]) -> Maybe FilePath -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
x
                Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ Maybe [Text] -> Log
LogEvalStmtResult Maybe [Text]
r
                Maybe [Text] -> Ghc (Maybe [Text])
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
r
        | -- An import
          ParserOpts -> FilePath -> Bool
isImport ParserOpts
pf FilePath
stmt =
            do
                Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Log
LogEvalImport FilePath
stmt
                [InteractiveImport]
_ <- FilePath -> Ghc [InteractiveImport]
forall (m :: * -> *).
GhcMonad m =>
FilePath -> m [InteractiveImport]
addImport FilePath
stmt
                Maybe [Text] -> Ghc (Maybe [Text])
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
forall a. Maybe a
Nothing
        | -- A declaration
          Bool
otherwise =
            do
                Log -> Ghc ()
forall {m :: * -> *}. MonadIO m => Log -> m ()
dbg (Log -> Ghc ()) -> Log -> Ghc ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Log
LogEvalDeclaration FilePath
stmt
                Ghc [Name] -> Ghc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ghc [Name] -> Ghc ()) -> Ghc [Name] -> Ghc ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Ghc [Name]
forall (m :: * -> *). GhcMonad m => FilePath -> m [Name]
runDecls FilePath
stmt
                Maybe [Text] -> Ghc (Maybe [Text])
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
forall a. Maybe a
Nothing
    pf :: ParserOpts
pf = DynFlags -> ParserOpts
initParserOpts DynFlags
df
    unhelpfulReason :: UnhelpfulSpanReason
unhelpfulReason = UnhelpfulSpanReason
UnhelpfulInteractive
    exec :: FilePath -> Int -> Ghc (Either FilePath (Maybe FilePath))
exec FilePath
stmt Int
l =
        let opts :: ExecOptions
opts = ExecOptions
execOptions{execSourceFile = fp, execLineNumber = l}
         in FilePath -> ExecOptions -> Ghc (Either FilePath (Maybe FilePath))
myExecStmt FilePath
stmt ExecOptions
opts

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

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

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

{- |
 Convert error messages to a list of text lines
 Remove unnecessary information.
-}
errorLines :: String -> [Text]
errorLines :: FilePath -> [Text]
errorLines =
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Text -> Bool
T.null
        ([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"CallStack" `T.isPrefixOf`))
        ([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
        (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> 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 :: FilePath -> [Text]
exceptionLines = (Index [Text] -> Traversal' [Text] (IxValue [Text])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [Text]
0 ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
"*** Exception: " <>)) ([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [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 `T.append`) (Text -> Text) -> (Text -> Text) -> Text -> Text
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 <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
    case Text -> [(Text, GHCiLikeCmd)] -> Maybe GHCiLikeCmd
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
cmd [(Text, GHCiLikeCmd)]
ghciLikeCommands
        Maybe GHCiLikeCmd -> Maybe GHCiLikeCmd -> Maybe GHCiLikeCmd
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text, GHCiLikeCmd) -> GHCiLikeCmd
forall a b. (a, b) -> b
snd
        ((Text, GHCiLikeCmd) -> GHCiLikeCmd)
-> Maybe (Text, GHCiLikeCmd) -> Maybe GHCiLikeCmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, GHCiLikeCmd) -> Bool)
-> [(Text, GHCiLikeCmd)] -> Maybe (Text, GHCiLikeCmd)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
T.isPrefixOf Text
cmd (Text -> Bool)
-> ((Text, GHCiLikeCmd) -> Text) -> (Text, GHCiLikeCmd) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, GHCiLikeCmd) -> Text
forall a b. (a, b) -> a
fst) [(Text, GHCiLikeCmd)]
ghciLikeCommands of
        Just GHCiLikeCmd
hndler ->
            (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                Text -> [Text]
T.lines
                (Maybe Text -> Maybe [Text])
-> Ghc (Maybe Text) -> Ghc (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCiLikeCmd
hndler DynFlags
df Text
arg
        Maybe GHCiLikeCmd
_ -> GhciLikeCmdException -> Ghc (Maybe [Text])
forall a e. Exception e => e -> a
E.throw (GhciLikeCmdException -> Ghc (Maybe [Text]))
-> GhciLikeCmdException -> Ghc (Maybe [Text])
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 <- (Text -> Ghc SDoc) -> [Text] -> Ghc [SDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Ghc SDoc
forall (m :: * -> *). GhcMonad m => Text -> m SDoc
infoThing (Text -> [Text]
T.words Text
s)
    Maybe Text -> Ghc (Maybe Text)
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Ghc (Maybe Text)) -> Maybe Text -> Ghc (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
sdocs)
    where
        infoThing :: GHC.GhcMonad m => Text -> m SDoc
        infoThing :: forall (m :: * -> *). GhcMonad m => Text -> m SDoc
infoThing (Text -> FilePath
T.unpack -> FilePath
str) = do
            NonEmpty Name
names     <- FilePath -> m (NonEmpty Name)
forall (m :: * -> *). GhcMonad m => FilePath -> m (NonEmpty Name)
GHC.parseName FilePath
str
            NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
mb_stuffs <- (Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
-> NonEmpty Name
-> m (NonEmpty
        (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
forall (m :: * -> *).
GhcMonad m =>
Bool
-> Name -> m (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
GHC.getInfo Bool
allInfo) NonEmpty Name
names
            let filtered :: [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
filtered = ((TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> TyThing)
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. (a -> TyThing) -> [a] -> [a]
filterOutChildren (\(TyThing
t,Fixity
_f,[ClsInst]
_ci,[FamInst]
_fi,SDoc
_sd) -> TyThing
t)
                                            ([Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
 -> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)])
-> [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
-> [(TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
-> [Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
mb_stuffs)
            SDoc -> m SDoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> m SDoc) -> SDoc -> m SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"") ([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]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
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 ((a -> Name) -> [a] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (TyThing -> Name
forall a. NamedThing a => a -> Name
getName (TyThing -> Name) -> (a -> TyThing) -> a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TyThing
get_thing) [a]
xs)
                has_parent :: a -> Bool
has_parent a
x = case TyThing -> Maybe TyThing
tyThingParent_maybe (a -> TyThing
get_thing a
x) of
                                Just TyThing
p  -> TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
p Name -> NameSet -> Bool
`elemNameSet` NameSet
all_names
                                Maybe TyThing
Nothing -> Bool
False

        pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
        pprInfo :: (TyThing, Fixity, [ClsInst], [FamInst], SDoc) -> SDoc
pprInfo (TyThing
thing, Fixity
fixity, [ClsInst]
cls_insts, [FamInst]
fam_insts, SDoc
docs)
            =  SDoc
docs
            SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> SDoc
pprTyThingInContextLoc TyThing
thing
            SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ TyThing -> Fixity -> SDoc
showFixity TyThing
thing Fixity
fixity
            SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
GHC.pprInstance [ClsInst]
cls_insts)
            SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FamInst -> SDoc) -> [FamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> SDoc
GHC.pprFamInst  [FamInst]
fam_insts)

        pprTyThingInContextLoc :: TyThing -> SDoc
        pprTyThingInContextLoc :: TyThing -> SDoc
pprTyThingInContextLoc TyThing
tyThing
            = SDoc -> SDoc -> SDoc
showWithLoc (Name -> SDoc
pprDefinedAt (TyThing -> Name
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 (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"\t--" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
loc)

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

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) <- Bool -> FilePath -> Ghc (Type, Type)
forall (m :: * -> *).
GhcMonad m =>
Bool -> FilePath -> m (Type, Type)
typeKind Bool
False (FilePath -> Ghc (Type, Type)) -> FilePath -> Ghc (Type, Type)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
input
    let kindText :: SDoc
kindText = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Text -> FilePath
T.unpack Text
input) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
kind
    Maybe Text -> Ghc (Maybe Text)
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Ghc (Maybe Text)) -> Maybe Text -> Ghc (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (DynFlags -> SDoc -> FilePath
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) <- Bool -> FilePath -> Ghc (Type, Type)
forall (m :: * -> *).
GhcMonad m =>
Bool -> FilePath -> m (Type, Type)
typeKind Bool
True (FilePath -> Ghc (Type, Type)) -> FilePath -> Ghc (Type, Type)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
input
    let kindDoc :: SDoc
kindDoc = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Text -> FilePath
T.unpack Text
input) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
kind
        tyDoc :: SDoc
tyDoc = SDoc
"=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty
    Maybe Text -> Ghc (Maybe Text)
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Ghc (Maybe Text)) -> Maybe Text -> Ghc (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (DynFlags -> SDoc -> FilePath
showSDoc DynFlags
df (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ SDoc
kindDoc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ 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 <- TcRnExprMode -> FilePath -> Ghc Type
forall (m :: * -> *).
GhcMonad m =>
TcRnExprMode -> FilePath -> m Type
GHC.exprType TcRnExprMode
emod (FilePath -> Ghc Type) -> FilePath -> Ghc Type
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
expr
    let rawType :: Text
rawType = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprSigmaType Type
ty
        broken :: Bool
broken = (Char -> Bool) -> Text -> Bool
T.any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
rawType
    Maybe Text -> Ghc (Maybe Text)
forall a. a -> Ghc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Ghc (Maybe Text)) -> Maybe Text -> Ghc (Maybe Text)
forall a b. (a -> b) -> a -> b
$
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            if Bool
broken
                then
                    FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
                        DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dflags (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$
                            FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (Text -> FilePath
T.unpack Text
expr)
                                SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (SDoc
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty)
                else Text
expr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rawType Text -> Text -> Text
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
    (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
$sel:ghciCmdName:GhciLikeCmdNotImplemented :: GhciLikeCmdException -> Text
$sel:ghciCmdArg:GhciLikeCmdNotImplemented :: GhciLikeCmdException -> Text
ghciCmdName :: Text
ghciCmdArg :: Text
..} =
        FilePath -> ShowS
showString FilePath
"unknown command '"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (Text -> FilePath
T.unpack Text
ghciCmdName)
            ShowS -> ShowS -> ShowS
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 (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart Text
input
    (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text) -> Maybe (Text, Text))
-> (Text, Text) -> Maybe (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Text
T.strip ((Text, Text) -> (Text, Text)) -> (Text, Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpace Text
rest