{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
#ifdef HINT
{-# LANGUAGE FlexibleContexts #-}
#endif
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Eval
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Evaluator for actions ('Action', 'YiAction'). Uses a @GHCi@ session
-- under the hood.

module Yi.Eval (
        -- * Main (generic) evaluation interface
        execEditorAction,
        getAllNamesInScope,
        describeNamedAction,
        Evaluator(..),
        evaluator,
        -- ** Standard evaluators
#ifdef HINT
        ghciEvaluator,
#endif
        publishedActionsEvaluator,
        publishedActions,
        publishAction,
        -- * Eval/Interpretation
        jumpToErrorE,
        jumpToE,
        consoleKeymap
) where

import Prelude hiding (mapM_)

import Lens.Micro.Platform ( (^.), (.=), (%=) )
import Control.Monad (when, forever, void)
import Data.Array ( elems )
import Data.Binary ( Binary )
import Data.Default ( Default, def )
import Data.Foldable ( mapM_ )
import qualified Data.HashMap.Strict as M
    ( HashMap, insert, lookup, empty, keys )
import Data.Monoid ((<>))
import Data.Semigroup ( Semigroup )
import Data.Typeable ( Typeable )
#ifdef HINT
import Control.Concurrent
    ( takeMVar, putMVar, newEmptyMVar, MVar, forkIO )
import Control.Monad.Base ( MonadBase )
import Control.Monad.Catch ( try )
import Control.Monad.Trans ( lift )
import Data.Binary ( get, put )
import Data.List ( sort )
import qualified Language.Haskell.Interpreter as LHI
    ( typeOf,
      setImportsQ,
      searchPath,
      set,
      runInterpreter,
      ModuleElem(Data, Class, Fun),
      getModuleExports,
      as,
      loadModules,
      languageExtensions,
      OptionVal((:=)),
      InterpreterError,
      Extension(OverloadedStrings),
      setTopLevelModules,
      InterpreterT,
      interpret )
import System.Directory ( doesFileExist )
import Yi.Core ( errorEditor )
import Yi.Editor
    ( getEditorDyn,
      putEditorDyn,
      MonadEditor)
import qualified Yi.Paths ( getEvaluatorContextFilename )
import Yi.String ( showT )
import Yi.Utils ( io )
#endif
import Text.Read ( readMaybe )
import Yi.Buffer
    ( gotoLn,
      moveXorEol,
      BufferM,
      readLnB,
      pointB,
      botB,
      insertN,
      getBookmarkB,
      markPointA )
import Yi.Config.Simple.Types ( customVariable, Field, ConfigM )
import Yi.Core ( runAction )
import Yi.Types ( YiVariable, YiConfigVariable )
import Yi.Editor
    ( printMsg,
      askCfg,
      withCurrentBuffer,
      withCurrentBuffer )
import Yi.File ( openingNewFile )
import Yi.Hooks ( runHook )
import Yi.Keymap
    ( YiM, Action, YiAction, makeAction, Keymap, write )
import Yi.Keymap.Keys ( event, Event(..), Key(KEnter) )
import Yi.Regex ( Regex, makeRegex, matchOnceText )
import qualified Yi.Rope as R
    ( toString, YiString, splitAt, length )
import Yi.Utils ( makeLensesWithSuffix )

infixl 1 <&>
(<&>) :: Functor f => f a -> (a -> b) -> f b
f a
a <&> :: f a -> (a -> b) -> f b
<&> a -> b
f = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a
-- TODO: should we be sticking Text here?

-- | Runs the action, as written by the user.
--
-- The behaviour of this function can be customised by modifying the
-- 'Evaluator' variable.
execEditorAction :: String -> YiM ()
execEditorAction :: String -> YiM ()
execEditorAction = (Evaluator -> String -> YiM ()) -> String -> YiM ()
forall ty var.
(HookType ty, YiConfigVariable var) =>
(var -> ty) -> ty
runHook Evaluator -> String -> YiM ()
execEditorActionImpl

-- | Lists the action names in scope, for use by 'execEditorAction',
-- and 'help' index.
--
-- The behaviour of this function can be customised by modifying the
-- 'Evaluator' variable.
getAllNamesInScope :: YiM [String]
getAllNamesInScope :: YiM [String]
getAllNamesInScope = (Evaluator -> YiM [String]) -> YiM [String]
forall ty var.
(HookType ty, YiConfigVariable var) =>
(var -> ty) -> ty
runHook Evaluator -> YiM [String]
getAllNamesInScopeImpl

-- | Describes the named action in scope, for use by 'help'.
--
-- The behaviour of this function can be customised by modifying the
-- 'Evaluator' variable.
describeNamedAction :: String -> YiM String
describeNamedAction :: String -> YiM String
describeNamedAction = (Evaluator -> String -> YiM String) -> String -> YiM String
forall ty var.
(HookType ty, YiConfigVariable var) =>
(var -> ty) -> ty
runHook Evaluator -> String -> YiM String
describeNamedActionImpl

-- | Config variable for customising the behaviour of
-- 'execEditorAction' and 'getAllNamesInScope'.
--
-- Set this variable using 'evaluator'. See 'ghciEvaluator' and
-- 'finiteListEvaluator' for two implementation.
data Evaluator = Evaluator
  { Evaluator -> String -> YiM ()
execEditorActionImpl :: String -> YiM ()
    -- ^ implementation of 'execEditorAction'
  , Evaluator -> YiM [String]
getAllNamesInScopeImpl :: YiM [String]
    -- ^ implementation of 'getAllNamesInScope'
  , Evaluator -> String -> YiM String
describeNamedActionImpl :: String -> YiM String
    -- ^ describe named action (or at least its type.), simplest implementation is at least @return@.
  } deriving (Typeable)

-- | The evaluator to use for 'execEditorAction' and
-- 'getAllNamesInScope'.
evaluator :: Field Evaluator
evaluator :: (Evaluator -> f Evaluator) -> Config -> f Config
evaluator = (Evaluator -> f Evaluator) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable

-- * Evaluator based on GHCi
-- | Cached variable for getAllNamesInScopeImpl
newtype NamesCache = NamesCache [String] deriving (Typeable, Get NamesCache
[NamesCache] -> Put
NamesCache -> Put
(NamesCache -> Put)
-> Get NamesCache -> ([NamesCache] -> Put) -> Binary NamesCache
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [NamesCache] -> Put
$cputList :: [NamesCache] -> Put
get :: Get NamesCache
$cget :: Get NamesCache
put :: NamesCache -> Put
$cput :: NamesCache -> Put
Binary)

instance Default NamesCache where
    def :: NamesCache
def = [String] -> NamesCache
NamesCache []
instance YiVariable NamesCache

-- | Cached dictioary for describeNameImpl
newtype HelpCache = HelpCache (M.HashMap String String) deriving (Typeable, Get HelpCache
[HelpCache] -> Put
HelpCache -> Put
(HelpCache -> Put)
-> Get HelpCache -> ([HelpCache] -> Put) -> Binary HelpCache
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [HelpCache] -> Put
$cputList :: [HelpCache] -> Put
get :: Get HelpCache
$cget :: Get HelpCache
put :: HelpCache -> Put
$cput :: HelpCache -> Put
Binary)

instance Default HelpCache where
    def :: HelpCache
def = HashMap String String -> HelpCache
HelpCache HashMap String String
forall k v. HashMap k v
M.empty
instance YiVariable HelpCache

#ifdef HINT
data HintRequest = HintEvaluate String (MVar (Either LHI.InterpreterError Action))
                 | HintGetNames (MVar (Either LHI.InterpreterError [LHI.ModuleElem]))
                 | HintDescribe String (MVar (Either LHI.InterpreterError String))
newtype HintThreadVar = HintThreadVar (Maybe (MVar HintRequest))
  deriving (Typeable, Default)

instance Binary HintThreadVar where
  put _ = return ()
  get = return def
instance YiVariable HintThreadVar

getHintThread :: (MonadEditor m, MonadBase IO m) => m (MVar HintRequest)
getHintThread = do
  HintThreadVar x <- getEditorDyn
  case x of
    Just t -> return t
    Nothing -> do
      req <- io newEmptyMVar
      contextFile <- Yi.Paths.getEvaluatorContextFilename
      void . io . forkIO $ hintEvaluatorThread req contextFile
      putEditorDyn . HintThreadVar $ Just req
      return req

hintEvaluatorThread :: MVar HintRequest -> FilePath -> IO ()
hintEvaluatorThread request contextFile = do
  haveUserContext <- doesFileExist contextFile
  void $ LHI.runInterpreter $ do
    LHI.set [LHI.searchPath LHI.:= []]

    LHI.set [LHI.languageExtensions LHI.:= [ LHI.OverloadedStrings ]]
    when haveUserContext $ do
      LHI.loadModules [contextFile]
      LHI.setTopLevelModules ["Env"]

    -- Yi.Keymap: Action lives there
    setImp <- try $ LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")] 
      :: LHI.InterpreterT IO (Either LHI.InterpreterError ())
    case setImp of
      Left e -> lift $ forever $ takeMVar request >>= \case
        HintEvaluate _ response -> putMVar response (Left e)
        HintGetNames   response -> putMVar response (Left e)
        HintDescribe _ response -> putMVar response (Left e)
      Right _ -> forever $ lift (takeMVar request) >>= \case
        HintEvaluate s response -> do
          res <- try $ LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (LHI.as :: Action)
          lift $ putMVar response res
        HintGetNames response -> do
          res <- try $ LHI.getModuleExports "Yi"
          lift $ putMVar response res
        HintDescribe name response -> do
          res <- try $ LHI.typeOf name
          lift $ putMVar response res

-- Evaluator implemented by calling GHCi. This evaluator can run
-- arbitrary expressions in the class 'YiAction'.
--
-- The following two imports are always present:
--
-- > import Yi
-- > import qualified Yi.Keymap as Yi.Keymap
--
-- Also, if the file
--
-- > $HOME/.config/yi/local/Env.hs
--
-- exists, it is imported unqualified.
ghciEvaluator :: Evaluator
ghciEvaluator = Evaluator { execEditorActionImpl = execAction
                          , getAllNamesInScopeImpl = getNames
                          , describeNamedActionImpl = describeName -- TODO: use haddock to add docs
                          }
  where
    execAction :: String -> YiM ()
    execAction s = do
      request <- getHintThread
      res <- io $ do
        response <- newEmptyMVar
        putMVar request (HintEvaluate s response)
        takeMVar response
      case res of
        Left err -> errorEditor (showT err)
        Right action -> runAction action

    getNames :: YiM [String]
    getNames = do
      NamesCache cache <- getEditorDyn
      result <- if null cache
                then do
                  request <- getHintThread
                  res <- io $ do
                    response <- newEmptyMVar
                    putMVar request (HintGetNames response)
                    takeMVar response
                  return $ case res of
                    Left err -> [show err]
                    Right exports -> flattenExports exports
                else return $ sort cache
      putEditorDyn $ NamesCache result
      return result

    flattenExports :: [LHI.ModuleElem] -> [String]
    flattenExports = concatMap flattenExport

    flattenExport :: LHI.ModuleElem -> [String]
    flattenExport (LHI.Fun x) = [x]
    flattenExport (LHI.Class _ xs) = xs
    flattenExport (LHI.Data _ xs) = xs
      
    describeName :: String -> YiM String
    describeName name = do
      HelpCache cache <- getEditorDyn
      description <- case name `M.lookup` cache of
                       Nothing -> do
                         request <- getHintThread
                         res <- io $ do
                           response <- newEmptyMVar
                           putMVar request (HintDescribe name response)
                           takeMVar response
                         let newDescription = either show id res
                         putEditorDyn $ HelpCache $ M.insert name newDescription cache
                         return newDescription
                       Just description -> return description
      return $ name ++ " :: " ++ description

#endif

-- * 'PublishedActions' evaluator

newtype PublishedActions = PublishedActions {
    PublishedActions -> HashMap String Action
_publishedActions :: M.HashMap String Action
  } deriving(Typeable, b -> PublishedActions -> PublishedActions
NonEmpty PublishedActions -> PublishedActions
PublishedActions -> PublishedActions -> PublishedActions
(PublishedActions -> PublishedActions -> PublishedActions)
-> (NonEmpty PublishedActions -> PublishedActions)
-> (forall b.
    Integral b =>
    b -> PublishedActions -> PublishedActions)
-> Semigroup PublishedActions
forall b. Integral b => b -> PublishedActions -> PublishedActions
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PublishedActions -> PublishedActions
$cstimes :: forall b. Integral b => b -> PublishedActions -> PublishedActions
sconcat :: NonEmpty PublishedActions -> PublishedActions
$csconcat :: NonEmpty PublishedActions -> PublishedActions
<> :: PublishedActions -> PublishedActions -> PublishedActions
$c<> :: PublishedActions -> PublishedActions -> PublishedActions
Semigroup, Semigroup PublishedActions
PublishedActions
Semigroup PublishedActions
-> PublishedActions
-> (PublishedActions -> PublishedActions -> PublishedActions)
-> ([PublishedActions] -> PublishedActions)
-> Monoid PublishedActions
[PublishedActions] -> PublishedActions
PublishedActions -> PublishedActions -> PublishedActions
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PublishedActions] -> PublishedActions
$cmconcat :: [PublishedActions] -> PublishedActions
mappend :: PublishedActions -> PublishedActions -> PublishedActions
$cmappend :: PublishedActions -> PublishedActions -> PublishedActions
mempty :: PublishedActions
$cmempty :: PublishedActions
$cp1Monoid :: Semigroup PublishedActions
Monoid)

instance Default PublishedActions where def :: PublishedActions
def = PublishedActions
forall a. Monoid a => a
mempty

makeLensesWithSuffix "A" ''PublishedActions
instance YiConfigVariable PublishedActions

-- | Accessor for the published actions. Consider using
-- 'publishAction'.
publishedActions :: Field (M.HashMap String Action)
publishedActions :: (HashMap String Action -> f (HashMap String Action))
-> Config -> f Config
publishedActions = (PublishedActions -> f PublishedActions) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable ((PublishedActions -> f PublishedActions) -> Config -> f Config)
-> ((HashMap String Action -> f (HashMap String Action))
    -> PublishedActions -> f PublishedActions)
-> (HashMap String Action -> f (HashMap String Action))
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap String Action -> f (HashMap String Action))
-> PublishedActions -> f PublishedActions
Lens' PublishedActions (HashMap String Action)
_publishedActionsA

-- | Publish the given action, by the given name. This will overwrite
-- any existing actions by the same name.
publishAction :: (YiAction a x, Show x) => String -> a -> ConfigM ()
publishAction :: String -> a -> ConfigM ()
publishAction String
s a
a = (HashMap String Action -> Identity (HashMap String Action))
-> Config -> Identity Config
Field (HashMap String Action)
publishedActions ((HashMap String Action -> Identity (HashMap String Action))
 -> Config -> Identity Config)
-> (HashMap String Action -> HashMap String Action) -> ConfigM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= String -> Action -> HashMap String Action -> HashMap String Action
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert String
s (a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction a
a)

-- | Evaluator based on a fixed list of published actions. Has a few
-- differences from 'ghciEvaluator':
--
-- * expressions can't be evaluated
--
-- * all suggested actions are actually valued
--
-- * (related to the above) doesn't contain junk actions from Prelude
--
-- * doesn't require GHCi backend, so uses less memory
publishedActionsEvaluator :: Evaluator
publishedActionsEvaluator :: Evaluator
publishedActionsEvaluator = Evaluator :: (String -> YiM ())
-> YiM [String] -> (String -> YiM String) -> Evaluator
Evaluator
  { getAllNamesInScopeImpl :: YiM [String]
getAllNamesInScopeImpl = YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg YiM Config -> (Config -> [String]) -> YiM [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> HashMap String Action -> [String]
forall k v. HashMap k v -> [k]
M.keys (HashMap String Action -> [String])
-> (Config -> HashMap String Action) -> Config -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config
-> Getting (HashMap String Action) Config (HashMap String Action)
-> HashMap String Action
forall s a. s -> Getting a s a -> a
^. Getting (HashMap String Action) Config (HashMap String Action)
Field (HashMap String Action)
publishedActions)
  , execEditorActionImpl :: String -> YiM ()
execEditorActionImpl = \String
s ->
      YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg YiM Config -> (Config -> Maybe Action) -> YiM (Maybe Action)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> HashMap String Action -> Maybe Action
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup String
s (HashMap String Action -> Maybe Action)
-> (Config -> HashMap String Action) -> Config -> Maybe Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config
-> Getting (HashMap String Action) Config (HashMap String Action)
-> HashMap String Action
forall s a. s -> Getting a s a -> a
^. Getting (HashMap String Action) Config (HashMap String Action)
Field (HashMap String Action)
publishedActions) YiM (Maybe Action) -> (Maybe Action -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Action -> YiM ()) -> Maybe Action -> YiM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Action -> YiM ()
runAction
  , describeNamedActionImpl :: String -> YiM String
describeNamedActionImpl = String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return -- TODO: try to show types using TemplateHaskell!
  }

-- * Miscellaneous interpreter

-- | Jumps to specified position in a given file.
jumpToE :: FilePath -- ^ Filename to make the jump in.
        -> Int -- ^ Line to jump to.
        -> Int -- ^ Column to jump to.
        -> YiM ()
jumpToE :: String -> Int -> Int -> YiM ()
jumpToE String
filename Int
line Int
column =
  String -> BufferM () -> YiM ()
forall a. String -> BufferM a -> YiM ()
openingNewFile String
filename (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
line BufferM Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> BufferM ()
moveXorEol Int
column

-- | Regex parsing the error message format.
errorRegex :: Regex
errorRegex :: Regex
errorRegex = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (String
"^(.+):([0-9]+):([0-9]+):.*$" :: String)

-- | Parses an error message. Fails if it can't parse out the needed
-- information, namely filename, line number and column number.
parseErrorMessage :: R.YiString -> Maybe (String, Int, Int)
parseErrorMessage :: YiString -> Maybe (String, Int, Int)
parseErrorMessage YiString
ln = do
  (String
_ ,MatchText String
result, String
_) <- Regex -> String -> Maybe (String, MatchText String, String)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
errorRegex (YiString -> String
R.toString YiString
ln)
  case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
3 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, (Int, Int)) -> String)
-> [(String, (Int, Int))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Int, Int)) -> String
forall a b. (a, b) -> a
fst ([(String, (Int, Int))] -> [String])
-> [(String, (Int, Int))] -> [String]
forall a b. (a -> b) -> a -> b
$ MatchText String -> [(String, (Int, Int))]
forall i e. Array i e -> [e]
elems MatchText String
result of
    [String
_, String
fname, String
l, String
c] -> (,,) (String -> Int -> Int -> (String, Int, Int))
-> Maybe String -> Maybe (Int -> Int -> (String, Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fname Maybe (Int -> Int -> (String, Int, Int))
-> Maybe Int -> Maybe (Int -> (String, Int, Int))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
l Maybe (Int -> (String, Int, Int))
-> Maybe Int -> Maybe (String, Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
c
    [String]
_                        -> Maybe (String, Int, Int)
forall a. Maybe a
Nothing

-- | Tries to parse an error message at current line using
-- 'parseErrorMessage'.
parseErrorMessageB :: BufferM (Maybe (String, Int, Int))
parseErrorMessageB :: BufferM (Maybe (String, Int, Int))
parseErrorMessageB = YiString -> Maybe (String, Int, Int)
parseErrorMessage (YiString -> Maybe (String, Int, Int))
-> BufferM YiString -> BufferM (Maybe (String, Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
readLnB

-- | Tries to jump to error at the current line. See
-- 'parseErrorMessageB'.
jumpToErrorE :: YiM ()
jumpToErrorE :: YiM ()
jumpToErrorE = BufferM (Maybe (String, Int, Int))
-> YiM (Maybe (String, Int, Int))
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Maybe (String, Int, Int))
parseErrorMessageB YiM (Maybe (String, Int, Int))
-> (Maybe (String, Int, Int) -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe (String, Int, Int)
Nothing -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Couldn't parse out an error message."
  Just (String
f, Int
l, Int
c) -> String -> Int -> Int -> YiM ()
jumpToE String
f Int
l Int
c

prompt :: R.YiString
prompt :: YiString
prompt = YiString
"Yi> "

-- | Tries to strip the 'prompt' from the front of the given 'String'.
-- If the prompt is not found, returns the input command as-is.
takeCommand :: R.YiString -> R.YiString
takeCommand :: YiString -> YiString
takeCommand YiString
t = case Int -> YiString -> (YiString, YiString)
R.splitAt (YiString -> Int
R.length YiString
prompt) YiString
t of
  (YiString
f, YiString
s) -> if YiString
f YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
prompt then YiString
s else YiString
t

consoleKeymap :: Keymap
consoleKeymap :: Keymap
consoleKeymap = do
  Event
_ <- Event -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
event -> m event
event (Key -> [Modifier] -> Event
Event Key
KEnter [])
  YiM () -> Keymap
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (YiM () -> Keymap) -> YiM () -> Keymap
forall a b. (a -> b) -> a -> b
$ BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
readLnB YiM YiString -> (YiString -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \YiString
x -> case YiString -> Maybe (String, Int, Int)
parseErrorMessage YiString
x of
    Just (String
f,Int
l,Int
c) -> String -> Int -> Int -> YiM ()
jumpToE String
f Int
l Int
c
    Maybe (String, Int, Int)
Nothing -> do
      BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
        Point
p <- BufferM Point
pointB
        BufferM ()
botB
        Point
p' <- BufferM Point
pointB
        Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
p') (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> BufferM ()
insertN (YiString
"\n" YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
prompt YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString -> YiString
takeCommand YiString
x)
        YiString -> BufferM ()
insertN YiString
"\n"
        Point
pt <- BufferM Point
pointB
        YiString -> BufferM ()
insertN YiString
prompt
        Mark
bm <- String -> BufferM Mark
getBookmarkB String
"errorInsert"
        Mark -> Lens' FBuffer Point
markPointA Mark
bm ((Point -> Identity Point) -> FBuffer -> Identity FBuffer)
-> Point -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Point
pt
      String -> YiM ()
execEditorAction (String -> YiM ()) -> (YiString -> String) -> YiString -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> String
R.toString (YiString -> YiM ()) -> YiString -> YiM ()
forall a b. (a -> b) -> a -> b
$ YiString -> YiString
takeCommand YiString
x

instance Default Evaluator where
#ifdef HINT
    def = ghciEvaluator
#else
    def :: Evaluator
def = Evaluator
publishedActionsEvaluator
#endif

instance YiConfigVariable Evaluator