{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE RecursiveDo         #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Core
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The core actions of Yi. This module is the link between the editor
-- and the UI. Key bindings, and libraries should manipulate Yi
-- through the interface defined here.

module Yi.Core
  (
  -- * Construction and destruction
    startEditor
  , quitEditor             -- :: YiM ()
  , quitEditorWithExitCode -- :: ExitCode -> YiM ()

  -- * User interaction
  , refreshEditor          -- :: YiM ()
  , suspendEditor          -- :: YiM ()
  , userForceRefresh

  -- * Global editor actions
  , errorEditor            -- :: String -> YiM ()
  , closeWindow            -- :: YiM ()
  , closeWindowEmacs

  -- * Interacting with external commands
  , runProcessWithInput    -- :: String -> String -> YiM String
  , startSubprocess        -- :: FilePath -> [String] -> YiM ()
  , sendToProcess

  -- * Misc
  , runAction
  , withSyntax
  , focusAllSyntax
  , onYiVar
  ) where

import           Prelude                        hiding (elem, mapM_, or)

import           Control.Concurrent             (forkOS, modifyMVar, modifyMVar_
                                                ,newMVar, readMVar, threadDelay)
import           Control.Exc                    (ignoringException)
import           Control.Exception              (SomeException, handle)
import           Lens.Micro.Platform            (mapped, use, view, (%=), (%~),
                                                 (&), (.=), (.~), (^.))
import           Control.Monad                  (forever, void, when)
import           Control.Monad.Base             (MonadBase (liftBase))
import           Control.Monad.Except           ()
import           Control.Monad.Reader           (MonadReader (ask), ReaderT (runReaderT), asks)
import qualified Data.DelayList                 as DelayList (decrease, insert)
import           Data.Foldable                  (elem, find, forM_, mapM_, or, toList)
import           Data.List                      (partition)
import           Data.List.NonEmpty             (NonEmpty (..))
import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), length)
import           Data.List.Split                (splitOn)
import qualified Data.Map                       as M (assocs, delete, empty, fromList, insert, member)
import           Data.Maybe                     (fromMaybe, isNothing)
import           Data.Monoid                    (First (First, getFirst), (<>), mempty)
import qualified Data.Text                      as T (Text, pack, unwords)
import           Data.Time                      (getCurrentTime)
import           Data.Time.Clock.POSIX          (posixSecondsToUTCTime)
import           Data.Traversable               (forM)
import           GHC.Conc                       (labelThread)
import           System.Directory               (doesFileExist)
import           System.Exit                    (ExitCode (ExitSuccess))
import           System.IO                      (Handle, hPutStr, hWaitForInput)
import           System.PosixCompat.Files       (getFileStatus, modificationTime)
import           System.Process                 (ProcessHandle,
                                                 getProcessExitCode,
                                                 readProcessWithExitCode,
                                                 terminateProcess)
import           Yi.Buffer
import           Yi.Config
import           Yi.Debug                       (logPutStrLn)
import           Yi.Editor
import           Yi.Keymap
import           Yi.Keymap.Keys
import           Yi.KillRing                    (krEndCmd)
import           Yi.Monad                       (gets, uses)
import           Yi.PersistentState             (loadPersistentState, savePersistentState)
import           Yi.Process
import qualified Yi.Rope                        as R (YiString, fromString, readFile)
import           Yi.String                      (chomp, showT)
import           Yi.Style                       (errorStyle, strongHintStyle)
import qualified Yi.UI.Common                   as UI (UI (end, layout, main, refresh, suspend, userForceRefresh))
import           Yi.Utils                       (io)
import           Yi.Window                      (bufkey, dummyWindow, isMini, winRegion, wkey)

-- | Make an action suitable for an interactive run.
-- UI will be refreshed.
interactive :: IsRefreshNeeded -> [Action] -> YiM ()
interactive :: IsRefreshNeeded -> [Action] -> YiM ()
interactive IsRefreshNeeded
isRefreshNeeded [Action]
action = do
  [Event]
evs <- EditorM [Event] -> YiM [Event]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM [Event] -> YiM [Event]) -> EditorM [Event] -> YiM [Event]
forall a b. (a -> b) -> a -> b
$ Getting [Event] Editor [Event] -> EditorM [Event]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [Event] Editor [Event]
Lens' Editor [Event]
pendingEventsA
  Text -> YiM ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
">>> interactively" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Event] -> Text
showEvs [Event]
evs
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ (Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> Editor -> Identity Editor
Lens' Editor (Map BufferRef FBuffer)
buffersA ((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
 -> Editor -> Identity Editor)
-> (Map BufferRef FBuffer -> Map BufferRef FBuffer) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((FBuffer -> FBuffer)
-> Map BufferRef FBuffer -> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FBuffer -> FBuffer)
 -> Map BufferRef FBuffer -> Map BufferRef FBuffer)
-> (FBuffer -> FBuffer)
-> Map BufferRef FBuffer
-> Map BufferRef FBuffer
forall a b. (a -> b) -> a -> b
$ (URList -> Identity URList) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c URList
undosA ((URList -> Identity URList) -> FBuffer -> Identity FBuffer)
-> (URList -> URList) -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Change -> URList -> URList
addChangeU Change
InteractivePoint)
  (Action -> YiM ()) -> [Action] -> YiM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Action -> YiM ()
runAction [Action]
action
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ (Killring -> Identity Killring) -> Editor -> Identity Editor
Lens' Editor Killring
killringA ((Killring -> Identity Killring) -> Editor -> Identity Editor)
-> (Killring -> Killring) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Killring -> Killring
krEndCmd
  Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsRefreshNeeded
isRefreshNeeded IsRefreshNeeded -> IsRefreshNeeded -> Bool
forall a. Eq a => a -> a -> Bool
== IsRefreshNeeded
MustRefresh) YiM ()
refreshEditor
  Text -> YiM ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn Text
"<<<"
  () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ---------------------------------------------------------------------
-- | Start up the editor, setting any state with the user preferences
-- and file names passed in, and turning on the UI
--
startEditor :: Config -> Maybe Editor -> IO ()
startEditor :: Config -> Maybe Editor -> IO ()
startEditor Config
cfg Maybe Editor
st = do
    let uiStart :: UIBoot
uiStart = Config -> UIBoot
startFrontEnd Config
cfg

    Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn Text
"Starting Core"

    -- Use an empty state unless resuming from an earlier session and
    -- one is already available
    let editor :: Editor
editor = Editor -> Maybe Editor -> Editor
forall a. a -> Maybe a -> a
fromMaybe Editor
emptyEditor Maybe Editor
st
    -- here to add load history etc?

    -- Setting up the 1st window is a bit tricky because most
    -- functions assume there exists a "current window"
    MVar YiVar
newSt <- YiVar -> IO (MVar YiVar)
forall a. a -> IO (MVar a)
newMVar (YiVar -> IO (MVar YiVar)) -> YiVar -> IO (MVar YiVar)
forall a b. (a -> b) -> a -> b
$ Editor -> SubprocessId -> Map SubprocessId SubprocessInfo -> YiVar
YiVar Editor
editor SubprocessId
1 Map SubprocessId SubprocessInfo
forall k a. Map k a
M.empty
    (UI Editor
ui, YiM () -> IO ()
runYi) <- mdo
        let handler :: SomeException -> IO ()
handler (SomeException
exception :: SomeException) =
              YiM () -> IO ()
runYi (YiM () -> IO ()) -> YiM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
errorEditor (SomeException -> Text
forall a. Show a => a -> Text
showT SomeException
exception) YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
refreshEditor

            inF :: [Event] -> IO ()
inF []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            inF (Event
e:[Event]
es) = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO ()
handler (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ YiM () -> IO ()
runYi (YiM () -> IO ()) -> YiM () -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Event -> YiM ()
dispatch (Event
e Event -> [Event] -> NonEmpty Event
forall a. a -> [a] -> NonEmpty a
:| [Event]
es)

            outF :: IsRefreshNeeded -> [Action] -> IO ()
outF IsRefreshNeeded
refreshNeeded [Action]
acts =
                (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO ()
handler (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ YiM () -> IO ()
runYi (YiM () -> IO ()) -> YiM () -> IO ()
forall a b. (a -> b) -> a -> b
$ IsRefreshNeeded -> [Action] -> YiM ()
interactive IsRefreshNeeded
refreshNeeded [Action]
acts
            runYi :: YiM () -> IO ()
runYi YiM ()
f   = ReaderT Yi IO () -> Yi -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (YiM () -> ReaderT Yi IO ()
forall a. YiM a -> ReaderT Yi IO a
runYiM YiM ()
f) Yi
yi
            yi :: Yi
yi        = UI Editor
-> ([Event] -> IO ())
-> (IsRefreshNeeded -> [Action] -> IO ())
-> Config
-> MVar YiVar
-> Yi
Yi UI Editor
ui [Event] -> IO ()
inF IsRefreshNeeded -> [Action] -> IO ()
outF Config
cfg MVar YiVar
newSt
        UI Editor
ui <- UIBoot
uiStart Config
cfg [Event] -> IO ()
inF (IsRefreshNeeded -> [Action] -> IO ()
outF IsRefreshNeeded
MustRefresh) Editor
editor
        (UI Editor, YiM () -> IO ()) -> IO (UI Editor, YiM () -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (UI Editor
ui, YiM () -> IO ()
runYi)

    YiM () -> IO ()
runYi YiM ()
loadPersistentState

    YiM () -> IO ()
runYi (YiM () -> IO ()) -> YiM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      if Maybe Editor -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Editor
st
        -- process options if booting for the first time
        then IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
NoNeedToRefresh ([Action] -> YiM ()) -> [Action] -> YiM ()
forall a b. (a -> b) -> a -> b
$ Config -> [Action]
startActions Config
cfg
        -- otherwise: recover the mode of buffers
        else EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ (Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> Editor -> Identity Editor
Lens' Editor (Map BufferRef FBuffer)
buffersA((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
 -> Editor -> Identity Editor)
-> ((FBuffer -> Identity FBuffer)
    -> Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> (FBuffer -> Identity FBuffer)
-> Editor
-> Identity Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FBuffer -> Identity FBuffer)
-> Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer)
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mapped ((FBuffer -> Identity FBuffer) -> Editor -> Identity Editor)
-> (FBuffer -> FBuffer) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= [AnyMode] -> FBuffer -> FBuffer
recoverMode (Config -> [AnyMode]
modeTable Config
cfg)
      IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
NoNeedToRefresh ([Action] -> YiM ()) -> [Action] -> YiM ()
forall a b. (a -> b) -> a -> b
$ Config -> [Action]
initialActions Config
cfg [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [YiM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction YiM ()
showErrors]

    YiM () -> IO ()
runYi YiM ()
refreshEditor

    UI Editor -> IO ()
forall e. UI e -> IO ()
UI.main UI Editor
ui -- transfer control to UI


recoverMode :: [AnyMode] -> FBuffer -> FBuffer
recoverMode :: [AnyMode] -> FBuffer -> FBuffer
recoverMode [AnyMode]
tbl FBuffer
buffer  = case AnyMode -> Maybe AnyMode -> AnyMode
forall a. a -> Maybe a -> a
fromMaybe (Mode Any -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode Any
forall syntax. Mode syntax
emptyMode) ((AnyMode -> Bool) -> [AnyMode] -> Maybe AnyMode
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(AnyMode Mode syntax
m) -> Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName Mode syntax
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
oldName) [AnyMode]
tbl) of
    AnyMode Mode syntax
m -> Mode syntax -> FBuffer -> FBuffer
forall syntax. Mode syntax -> FBuffer -> FBuffer
setMode0 Mode syntax
m FBuffer
buffer
  where oldName :: Text
oldName = case FBuffer
buffer of FBuffer {bmode :: ()
bmode = Mode syntax
m} -> Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName Mode syntax
m

postActions :: IsRefreshNeeded -> [Action] -> YiM ()
postActions :: IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
refreshNeeded [Action]
actions = do Yi
yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask; IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Yi -> IsRefreshNeeded -> [Action] -> IO ()
yiOutput Yi
yi IsRefreshNeeded
refreshNeeded [Action]
actions

-- | Display the errors buffer in a new split window if it exists.
showErrors :: YiM ()
showErrors :: YiM ()
showErrors = EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
               Bool
bs <- (Editor -> Bool) -> EditorM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> Bool) -> EditorM Bool)
-> (Editor -> Bool) -> EditorM Bool
forall a b. (a -> b) -> a -> b
$ Text -> Editor -> Bool
doesBufferNameExist Text
"*errors*"
               Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bs (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do 
                 EditorM ()
splitE
                 Text -> EditorM ()
switchToBufferWithNameE Text
"*errors*"

-- | Process events by advancing the current keymap automaton and
-- executing the generated actions.
dispatch :: NonEmpty Event -> YiM ()
dispatch :: NonEmpty Event -> YiM ()
dispatch (Event
ev :| [Event]
evs) = do
  Yi
yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
  ([Action]
userActions, P Event Action
_p') <- BufferM ([Action], P Event Action)
-> YiM ([Action], P Event Action)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM ([Action], P Event Action)
 -> YiM ([Action], P Event Action))
-> BufferM ([Action], P Event Action)
-> YiM ([Action], P Event Action)
forall a b. (a -> b) -> a -> b
$ do
    KeymapSet -> KeymapSet
keymap <- (FBuffer -> KeymapSet -> KeymapSet)
-> BufferM (KeymapSet -> KeymapSet)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((forall syntax. Mode syntax -> KeymapSet -> KeymapSet)
-> FBuffer -> KeymapSet -> KeymapSet
forall a. (forall syntax. Mode syntax -> a) -> FBuffer -> a
withMode0 forall syntax. Mode syntax -> KeymapSet -> KeymapSet
modeKeymap)
    P Event Action
p0 <- Getting (P Event Action) FBuffer (P Event Action)
-> BufferM (P Event Action)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (P Event Action) FBuffer (P Event Action)
forall c. HasAttributes c => Lens' c (P Event Action)
keymapProcessA
    let km :: Keymap
km = KeymapSet -> Keymap
extractTopKeymap (KeymapSet -> Keymap) -> KeymapSet -> Keymap
forall a b. (a -> b) -> a -> b
$ KeymapSet -> KeymapSet
keymap (KeymapSet -> KeymapSet) -> KeymapSet -> KeymapSet
forall a b. (a -> b) -> a -> b
$ Config -> KeymapSet
defaultKm (Config -> KeymapSet) -> Config -> KeymapSet
forall a b. (a -> b) -> a -> b
$ Yi -> Config
yiConfig Yi
yi
    let freshP :: P Event Action
freshP = P Event Event -> P Event Action -> P Event Action
forall event w mid.
(Show mid, Eq mid) =>
P event mid -> P mid w -> P event w
Chain (Config -> P Event Event
configInputPreprocess (Config -> P Event Event) -> Config -> P Event Event
forall a b. (a -> b) -> a -> b
$ Yi -> Config
yiConfig Yi
yi) (Keymap -> P Event Action
forall w ev a. Eq w => I ev w a -> P ev w
mkAutomaton Keymap
km)
        p :: P Event Action
p = case P Event Action -> InteractState Event Action
forall w event. Eq w => P event w -> InteractState event w
computeState P Event Action
p0 of
              InteractState Event Action
Dead  -> P Event Action
freshP
              InteractState Event Action
_     -> P Event Action
p0
        ([Action]
actions, P Event Action
p') = P Event Action -> Event -> ([Action], P Event Action)
forall w event. Eq w => P event w -> event -> ([w], P event w)
processOneEvent P Event Action
p Event
ev
        state :: InteractState Event Action
state = P Event Action -> InteractState Event Action
forall w event. Eq w => P event w -> InteractState event w
computeState P Event Action
p'
        ambiguous :: Bool
ambiguous = case InteractState Event Action
state of
            Ambiguous [(Int, Action, P Event Action)]
_ -> Bool
True
            InteractState Event Action
_ -> Bool
False
    (P Event Action -> Identity (P Event Action))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (P Event Action)
keymapProcessA ((P Event Action -> Identity (P Event Action))
 -> FBuffer -> Identity FBuffer)
-> P Event Action -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (if Bool
ambiguous then P Event Action
freshP else P Event Action
p')
    let actions0 :: [Action]
actions0 = case InteractState Event Action
state of
          InteractState Event Action
Dead -> [EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ do
                      [Event]
evs' <- Getting [Event] Editor [Event] -> EditorM [Event]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [Event] Editor [Event]
Lens' Editor [Event]
pendingEventsA
                      Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text
"Unrecognized input: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Event] -> Text
showEvs ([Event]
evs' [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++ [Event
ev]))]
          InteractState Event Action
_ -> [Action]
actions

        actions1 :: [Action]
actions1 = [ EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Keymap was in an ambiguous state! Resetting it.")
                   | Bool
ambiguous]

    ([Action], P Event Action) -> BufferM ([Action], P Event Action)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Action]
actions0 [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [Action]
actions1, P Event Action
p')

  let decay, pendingFeedback :: EditorM ()
      decay :: EditorM ()
decay = (Statuses -> Identity Statuses) -> Editor -> Identity Editor
Lens' Editor Statuses
statusLinesA ((Statuses -> Identity Statuses) -> Editor -> Identity Editor)
-> (Statuses -> Statuses) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> Statuses -> Statuses
forall a. Int -> DelayList a -> DelayList a
DelayList.decrease Int
1
      pendingFeedback :: EditorM ()
pendingFeedback = do ([Event] -> Identity [Event]) -> Editor -> Identity Editor
Lens' Editor [Event]
pendingEventsA (([Event] -> Identity [Event]) -> Editor -> Identity Editor)
-> ([Event] -> [Event]) -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ([Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++ [Event
ev])
                           if [Action] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Action]
userActions
                               then Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ()) -> ([Event] -> Text) -> [Event] -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
showEvs ([Event] -> EditorM ()) -> EditorM [Event] -> EditorM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting [Event] Editor [Event] -> EditorM [Event]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [Event] Editor [Event]
Lens' Editor [Event]
pendingEventsA
                               else ([Event] -> Identity [Event]) -> Editor -> Identity Editor
Lens' Editor [Event]
pendingEventsA (([Event] -> Identity [Event]) -> Editor -> Identity Editor)
-> [Event] -> EditorM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= []
      allActions :: [Action]
allActions = [EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction EditorM ()
decay] [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [Action]
userActions [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [EditorM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction EditorM ()
pendingFeedback]

  case [Event]
evs of
    [] -> IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
MustRefresh [Action]
allActions
    (Event
e:[Event]
es) -> IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
NoNeedToRefresh [Action]
allActions YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NonEmpty Event -> YiM ()
dispatch (Event
e Event -> [Event] -> NonEmpty Event
forall a. a -> [a] -> NonEmpty a
:| [Event]
es)


showEvs :: [Event] -> T.Text
showEvs :: [Event] -> Text
showEvs = [Text] -> Text
T.unwords ([Text] -> Text) -> ([Event] -> [Text]) -> [Event] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> Text) -> [Event] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (Event -> String) -> Event -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> String
prettyEvent)

-- ---------------------------------------------------------------------
-- Meta operations

-- | Quit.
quitEditor :: YiM ()
quitEditor :: YiM ()
quitEditor = ExitCode -> YiM ()
quitEditorWithExitCode ExitCode
ExitSuccess

-- | Quit with an exit code. (This is used to implement vim's :cq command)
quitEditorWithExitCode :: ExitCode -> YiM ()
quitEditorWithExitCode :: ExitCode -> YiM ()
quitEditorWithExitCode ExitCode
exitCode = do
    YiM ()
savePersistentState
    (Yi -> YiVar -> IO (YiVar, ())) -> YiM ()
forall a. (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar ((Yi -> YiVar -> IO (YiVar, ())) -> YiM ())
-> (Yi -> YiVar -> IO (YiVar, ())) -> YiM ()
forall a b. (a -> b) -> a -> b
$ (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ())
terminateSubprocesses (Bool -> SubprocessInfo -> Bool
forall a b. a -> b -> a
const Bool
True)
    (UI Editor -> IO ()) -> YiM ()
forall a. (UI Editor -> IO a) -> YiM a
withUI (UI Editor -> Maybe ExitCode -> IO ()
forall e. UI e -> Maybe ExitCode -> IO ()
`UI.end` (ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
exitCode))

-- | Update (visible) buffers if they have changed on disk.
-- FIXME: since we do IO here we must catch exceptions!
checkFileChanges :: Editor -> IO Editor
checkFileChanges :: Editor -> IO Editor
checkFileChanges Editor
e0 = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  -- Find out if any file was modified "behind our back" by
  -- other processes.
  Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
newBuffers <- Map BufferRef FBuffer
-> (FBuffer
    -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
-> IO
     (Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Editor -> Map BufferRef FBuffer
buffers Editor
e0) ((FBuffer -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
 -> IO
      (Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))))
-> (FBuffer
    -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
-> IO
     (Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
forall a b. (a -> b) -> a -> b
$ \FBuffer
b ->
    let nothing :: IO (FBuffer, Maybe a)
nothing = (FBuffer, Maybe a) -> IO (FBuffer, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FBuffer
b, Maybe a
forall a. Maybe a
Nothing)
    in if FBuffer -> BufferRef
bkey FBuffer
b BufferRef -> PointedList BufferRef -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` PointedList BufferRef
visibleBuffers
    then
      case FBuffer
b FBuffer -> Getting BufferId FBuffer BufferId -> BufferId
forall s a. s -> Getting a s a -> a
^. Getting BufferId FBuffer BufferId
forall c. HasAttributes c => Lens' c BufferId
identA of
         FileBuffer String
fname -> do
            Bool
fe <- String -> IO Bool
doesFileExist String
fname
            if Bool -> Bool
not Bool
fe then IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall a. IO (FBuffer, Maybe a)
nothing else do
                UTCTime
modTime <- String -> IO UTCTime
fileModTime String
fname
                if FBuffer
b FBuffer -> Getting UTCTime FBuffer UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime FBuffer UTCTime
forall c. HasAttributes c => Lens' c UTCTime
lastSyncTimeA UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
modTime
                   then if FBuffer -> Bool
isUnchangedBuffer FBuffer
b
                     then String -> IO (Either Text YiString)
R.readFile String
fname IO (Either Text YiString)
-> (Either Text YiString
    -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
-> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
 -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
-> (Either Text YiString
    -> (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))))
-> Either Text YiString
-> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                            Left Text
m ->
                              (FBuffer -> BufferM () -> FBuffer
forall a. FBuffer -> BufferM a -> FBuffer
runDummy FBuffer
b ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True), (Int, ([Text], UIStyle -> Style))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a. a -> Maybe a
Just ((Int, ([Text], UIStyle -> Style))
 -> Maybe (Int, ([Text], UIStyle -> Style)))
-> (Int, ([Text], UIStyle -> Style))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a b. (a -> b) -> a -> b
$ Text -> (Int, ([Text], UIStyle -> Style))
forall a a.
(Num a, Semigroup a, IsString a) =>
a -> (a, ([a], UIStyle -> Style))
msg3 Text
m)
                            Right YiString
newContents ->
                              (FBuffer -> BufferM () -> FBuffer
forall a. FBuffer -> BufferM a -> FBuffer
runDummy FBuffer
b (YiString -> UTCTime -> BufferM ()
revertB YiString
newContents UTCTime
now), (Int, ([Text], UIStyle -> Style))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a. a -> Maybe a
Just (Int, ([Text], UIStyle -> Style))
msg1)
                     else (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FBuffer
b, (Int, ([Text], UIStyle -> Style))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a. a -> Maybe a
Just (Int, ([Text], UIStyle -> Style))
msg2)
                   else IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall a. IO (FBuffer, Maybe a)
nothing
         BufferId
_ -> IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall a. IO (FBuffer, Maybe a)
nothing
    else IO (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
forall a. IO (FBuffer, Maybe a)
nothing
  -- show appropriate update message if applicable
  Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> Editor -> IO Editor
forall a b. (a -> b) -> a -> b
$ case First (Int, ([Text], UIStyle -> Style))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a. First a -> Maybe a
getFirst (((FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
 -> First (Int, ([Text], UIStyle -> Style)))
-> Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> First (Int, ([Text], UIStyle -> Style))
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe (Int, ([Text], UIStyle -> Style))
-> First (Int, ([Text], UIStyle -> Style))
forall a. Maybe a -> First a
First (Maybe (Int, ([Text], UIStyle -> Style))
 -> First (Int, ([Text], UIStyle -> Style)))
-> ((FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
    -> Maybe (Int, ([Text], UIStyle -> Style)))
-> (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> First (Int, ([Text], UIStyle -> Style))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> Maybe (Int, ([Text], UIStyle -> Style))
forall a b. (a, b) -> b
snd) Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
newBuffers) of
         Just (Int, ([Text], UIStyle -> Style))
msg -> ((Statuses -> Identity Statuses) -> Editor -> Identity Editor
Lens' Editor Statuses
statusLinesA ((Statuses -> Identity Statuses) -> Editor -> Identity Editor)
-> (Statuses -> Statuses) -> Editor -> Editor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int, ([Text], UIStyle -> Style)) -> Statuses -> Statuses
forall a. (Int, a) -> DelayList a -> DelayList a
DelayList.insert (Int, ([Text], UIStyle -> Style))
msg) Editor
e0 {buffers :: Map BufferRef FBuffer
buffers = ((FBuffer, Maybe (Int, ([Text], UIStyle -> Style))) -> FBuffer)
-> Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
-> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FBuffer, Maybe (Int, ([Text], UIStyle -> Style))) -> FBuffer
forall a b. (a, b) -> a
fst Map BufferRef (FBuffer, Maybe (Int, ([Text], UIStyle -> Style)))
newBuffers}
         Maybe (Int, ([Text], UIStyle -> Style))
Nothing -> Editor
e0
  where msg1 :: (Int, ([Text], UIStyle -> Style))
msg1 = (Int
1, ([Text
"File was changed by a concurrent process, reloaded!"], UIStyle -> Style
strongHintStyle))
        msg2 :: (Int, ([Text], UIStyle -> Style))
msg2 = (Int
1, ([Text
"Disk version changed by a concurrent process"], UIStyle -> Style
strongHintStyle))
        msg3 :: a -> (a, ([a], UIStyle -> Style))
msg3 a
x = (a
1, ([a
"File changed on disk to unknown encoding, not updating buffer: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x], UIStyle -> Style
strongHintStyle))
        visibleBuffers :: PointedList BufferRef
visibleBuffers = Window -> BufferRef
bufkey (Window -> BufferRef)
-> PointedList Window -> PointedList BufferRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> PointedList Window
windows Editor
e0
        fileModTime :: String -> IO UTCTime
fileModTime String
f = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (FileStatus -> POSIXTime) -> FileStatus -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (EpochTime -> POSIXTime)
-> (FileStatus -> EpochTime) -> FileStatus -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> EpochTime
modificationTime (FileStatus -> UTCTime) -> IO FileStatus -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
f
        runDummy :: FBuffer -> BufferM a -> FBuffer
runDummy FBuffer
b BufferM a
act = (a, FBuffer) -> FBuffer
forall a b. (a, b) -> b
snd ((a, FBuffer) -> FBuffer) -> (a, FBuffer) -> FBuffer
forall a b. (a -> b) -> a -> b
$ Window -> FBuffer -> BufferM a -> (a, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer (BufferRef -> Window
dummyWindow (BufferRef -> Window) -> BufferRef -> Window
forall a b. (a -> b) -> a -> b
$ FBuffer -> BufferRef
bkey FBuffer
b) FBuffer
b BufferM a
act

-- | Hide selection, clear "syntax dirty" flag (as appropriate).
clearAllSyntaxAndHideSelection :: Editor -> Editor
clearAllSyntaxAndHideSelection :: Editor -> Editor
clearAllSyntaxAndHideSelection = (Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> Editor -> Identity Editor
Lens' Editor (Map BufferRef FBuffer)
buffersA ((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
 -> Editor -> Identity Editor)
-> (Map BufferRef FBuffer -> Map BufferRef FBuffer)
-> Editor
-> Editor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FBuffer -> FBuffer)
-> Map BufferRef FBuffer -> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FBuffer -> FBuffer
clearSyntax (FBuffer -> FBuffer) -> (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> FBuffer
clearHighlight)
  where
    clearHighlight :: FBuffer -> FBuffer
clearHighlight FBuffer
fb =
      -- if there were updates, then hide the selection.
      let h :: Bool
h = Getting Bool FBuffer Bool -> FBuffer -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool FBuffer Bool
Lens' FBuffer Bool
highlightSelectionA FBuffer
fb
          us :: Seq UIUpdate
us = Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
-> FBuffer -> Seq UIUpdate
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Seq UIUpdate) FBuffer (Seq UIUpdate)
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA FBuffer
fb
      in (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
Lens' FBuffer Bool
highlightSelectionA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool
h Bool -> Bool -> Bool
&& Seq UIUpdate -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq UIUpdate
us) (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall a b. (a -> b) -> a -> b
$ FBuffer
fb


-- Focus syntax tree on the current window, for all visible buffers.
focusAllSyntax :: Editor -> Editor
focusAllSyntax :: Editor -> Editor
focusAllSyntax Editor
e6 = (Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> Editor -> Identity Editor
Lens' Editor (Map BufferRef FBuffer)
buffersA ((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
 -> Editor -> Identity Editor)
-> (Map BufferRef FBuffer -> Map BufferRef FBuffer)
-> Editor
-> Editor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FBuffer -> FBuffer)
-> Map BufferRef FBuffer -> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FBuffer
b -> Map WindowRef Region -> FBuffer -> FBuffer
focusSyntax (FBuffer -> Map WindowRef Region
regions FBuffer
b) FBuffer
b) (Editor -> Editor) -> Editor -> Editor
forall a b. (a -> b) -> a -> b
$ Editor
e6
    where regions :: FBuffer -> Map WindowRef Region
regions FBuffer
b = [(WindowRef, Region)] -> Map WindowRef Region
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Window -> WindowRef
wkey Window
w, Window -> Region
winRegion Window
w) | Window
w <- PointedList Window -> [Window]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PointedList Window -> [Window]) -> PointedList Window -> [Window]
forall a b. (a -> b) -> a -> b
$ Editor -> PointedList Window
windows Editor
e6, Window -> BufferRef
bufkey Window
w BufferRef -> BufferRef -> Bool
forall a. Eq a => a -> a -> Bool
== FBuffer -> BufferRef
bkey FBuffer
b]
          -- Why bother filtering the region list? After all the trees
          -- are lazily computed. Answer: focusing is an incremental
          -- algorithm. Each "focused" path depends on the previous
          -- one. If we left unforced focused paths, we'd create a
          -- long list of thunks: a memory leak.

-- | Redraw
refreshEditor :: YiM ()
refreshEditor :: YiM ()
refreshEditor = (Yi -> YiVar -> IO (YiVar, ())) -> YiM ()
forall a. (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar ((Yi -> YiVar -> IO (YiVar, ())) -> YiM ())
-> (Yi -> YiVar -> IO (YiVar, ())) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Yi
yi YiVar
var -> do
        let cfg :: Config
cfg = Yi -> Config
yiConfig Yi
yi
            runOnWins :: BufferM b -> Editor -> (Editor, PointedList b)
runOnWins BufferM b
a = Config
-> EditorM (PointedList b) -> Editor -> (Editor, PointedList b)
forall a. Config -> EditorM a -> Editor -> (Editor, a)
runEditor Config
cfg
                                    (do PointedList Window
ws <- Getting (PointedList Window) Editor (PointedList Window)
-> EditorM (PointedList Window)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (PointedList Window) Editor (PointedList Window)
Lens' Editor (PointedList Window)
windowsA
                                        PointedList Window
-> (Window -> EditorM b) -> EditorM (PointedList b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM PointedList Window
ws ((Window -> EditorM b) -> EditorM (PointedList b))
-> (Window -> EditorM b) -> EditorM (PointedList b)
forall a b. (a -> b) -> a -> b
$ (Window -> BufferM b -> EditorM b)
-> BufferM b -> Window -> EditorM b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> BufferM b -> EditorM b
forall a. Window -> BufferM a -> EditorM a
withWindowE BufferM b
a)
            style :: Maybe ScrollStyle
style = UIConfig -> Maybe ScrollStyle
configScrollStyle (UIConfig -> Maybe ScrollStyle) -> UIConfig -> Maybe ScrollStyle
forall a b. (a -> b) -> a -> b
$ Config -> UIConfig
configUI Config
cfg
        let scroll :: Editor -> IO Editor
scroll Editor
e3 = let (Editor
e4, PointedList Bool
relayout) = BufferM Bool -> Editor -> (Editor, PointedList Bool)
forall b. BufferM b -> Editor -> (Editor, PointedList b)
runOnWins (Maybe ScrollStyle -> BufferM Bool
snapScreenB Maybe ScrollStyle
style) Editor
e3 in
                -- Scroll windows to show current points as appropriate
                -- Do another layout pass if there was any scrolling;
                (if PointedList Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or PointedList Bool
relayout then UI Editor -> Editor -> IO Editor
forall e. UI e -> e -> IO e
UI.layout (Yi -> UI Editor
yiUi Yi
yi) else Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return) Editor
e4

        Editor
e7 <- (if Config -> Bool
configCheckExternalChangesObsessively Config
cfg
               then Editor -> IO Editor
checkFileChanges
               else Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return) (YiVar -> Editor
yiEditor YiVar
var) IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> (Editor -> Editor) -> Editor -> IO Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor -> Editor
clearAllSyntaxAndHideSelection IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             -- Adjust window sizes according to UI info
             UI Editor -> Editor -> IO Editor
forall e. UI e -> e -> IO e
UI.layout (Yi -> UI Editor
yiUi Yi
yi) IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Editor -> IO Editor
scroll IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             -- Adjust point according to the current layout;
             Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> (Editor -> Editor) -> Editor -> IO Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor, PointedList ()) -> Editor
forall a b. (a, b) -> a
fst ((Editor, PointedList ()) -> Editor)
-> (Editor -> (Editor, PointedList ())) -> Editor -> Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferM () -> Editor -> (Editor, PointedList ())
forall b. BufferM b -> Editor -> (Editor, PointedList b)
runOnWins BufferM ()
snapInsB IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> (Editor -> Editor) -> Editor -> IO Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor -> Editor
focusAllSyntax IO Editor -> (Editor -> IO Editor) -> IO Editor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             -- Clear "pending updates" and "followUp" from buffers.
             Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return (Editor -> IO Editor) -> (Editor -> Editor) -> Editor -> IO Editor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
-> Editor -> Identity Editor
Lens' Editor (Map BufferRef FBuffer)
buffersA ((Map BufferRef FBuffer -> Identity (Map BufferRef FBuffer))
 -> Editor -> Identity Editor)
-> (Map BufferRef FBuffer -> Map BufferRef FBuffer)
-> Editor
-> Editor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (FBuffer -> FBuffer)
-> Map BufferRef FBuffer -> Map BufferRef FBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FBuffer -> FBuffer
clearUpdates (FBuffer -> FBuffer) -> (FBuffer -> FBuffer) -> FBuffer -> FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBuffer -> FBuffer
clearFollow))
        -- Display the new state of the editor
        UI Editor -> Editor -> IO ()
forall e. UI e -> e -> IO ()
UI.refresh (Yi -> UI Editor
yiUi Yi
yi) Editor
e7
        -- Terminate stale processes.
        (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ())
terminateSubprocesses (Map BufferRef FBuffer -> SubprocessInfo -> Bool
forall a. Map BufferRef a -> SubprocessInfo -> Bool
staleProcess (Map BufferRef FBuffer -> SubprocessInfo -> Bool)
-> Map BufferRef FBuffer -> SubprocessInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Editor -> Map BufferRef FBuffer
buffers Editor
e7) Yi
yi YiVar
var {yiEditor :: Editor
yiEditor = Editor
e7}
  where
    clearUpdates :: FBuffer -> FBuffer
clearUpdates = (Seq UIUpdate -> Identity (Seq UIUpdate))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
pendingUpdatesA ((Seq UIUpdate -> Identity (Seq UIUpdate))
 -> FBuffer -> Identity FBuffer)
-> Seq UIUpdate -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq UIUpdate
forall a. Monoid a => a
mempty
    clearFollow :: FBuffer -> FBuffer
clearFollow = (Set WindowRef -> Identity (Set WindowRef))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Set WindowRef)
pointFollowsWindowA ((Set WindowRef -> Identity (Set WindowRef))
 -> FBuffer -> Identity FBuffer)
-> Set WindowRef -> FBuffer -> FBuffer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set WindowRef
forall a. Monoid a => a
mempty
    -- Is this process stale? (associated with a deleted buffer)
    staleProcess :: Map BufferRef a -> SubprocessInfo -> Bool
staleProcess Map BufferRef a
bs SubprocessInfo
p = Bool -> Bool
not (SubprocessInfo -> BufferRef
bufRef SubprocessInfo
p BufferRef -> Map BufferRef a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map BufferRef a
bs)


-- | Suspend the program
suspendEditor :: YiM ()
suspendEditor :: YiM ()
suspendEditor = (UI Editor -> IO ()) -> YiM ()
forall a. (UI Editor -> IO a) -> YiM a
withUI UI Editor -> IO ()
forall e. UI e -> IO ()
UI.suspend

------------------------------------------------------------------------

------------------------------------------------------------------------
-- | Pipe a string through an external command, returning the stdout
-- chomp any trailing newline (is this desirable?)
--
-- Todo: varients with marks?
--
runProcessWithInput :: String -> String -> YiM String
runProcessWithInput :: String -> String -> YiM String
runProcessWithInput String
cmd String
inp = do
    let (String
f:[String]
args) = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
" " String
cmd
    (ExitCode
_,String
out,String
_err) <- IO (ExitCode, String, String) -> YiM (ExitCode, String, String)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (ExitCode, String, String) -> YiM (ExitCode, String, String))
-> IO (ExitCode, String, String) -> YiM (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
f [String]
args String
inp
    String -> YiM String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> String
chomp String
"\n" String
out)

------------------------------------------------------------------------

-- | Same as 'Yi.Editor.printMsg', but do nothing instead of printing @()@
msgEditor :: T.Text -> YiM ()
msgEditor :: Text -> YiM ()
msgEditor Text
"()" = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
msgEditor Text
s = Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
s

runAction :: Action -> YiM ()
runAction :: Action -> YiM ()
runAction (YiA YiM a
act) = YiM a
act YiM a -> (a -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> YiM ()
msgEditor (Text -> YiM ()) -> (a -> Text) -> a -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
showT
runAction (EditorA EditorM a
act) = EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM a
act YiM a -> (a -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> YiM ()
msgEditor (Text -> YiM ()) -> (a -> Text) -> a -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
showT
runAction (BufferA BufferM a
act) = BufferM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM a
act YiM a -> (a -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> YiM ()
msgEditor (Text -> YiM ()) -> (a -> Text) -> a -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
showT

-- | Show an error on the status line and log it.
errorEditor :: T.Text -> YiM ()
errorEditor :: Text -> YiM ()
errorEditor Text
s = do
  ([Text], UIStyle -> Style) -> YiM ()
forall (m :: * -> *).
MonadEditor m =>
([Text], UIStyle -> Style) -> m ()
printStatus ([Text
"error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s], UIStyle -> Style
errorStyle)
  Text -> YiM ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"errorEditor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

-- | Close the current window.
-- If this is the last window open, quit the program.
--
-- CONSIDER: call quitEditor when there are no other window in the
-- 'interactive' function. (Not possible since the windowset type
-- disallows it -- should it be relaxed?)
closeWindow :: YiM ()
closeWindow :: YiM ()
closeWindow = do
    Int
winCount <- EditorM Int -> YiM Int
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Int -> YiM Int) -> EditorM Int -> YiM Int
forall a b. (a -> b) -> a -> b
$ Getting (PointedList Window) Editor (PointedList Window)
-> (PointedList Window -> Int) -> EditorM Int
forall s (m :: * -> *) a b.
MonadState s m =>
Getting a s a -> (a -> b) -> m b
uses Getting (PointedList Window) Editor (PointedList Window)
Lens' Editor (PointedList Window)
windowsA PointedList Window -> Int
forall a. PointedList a -> Int
PL.length
    Int
tabCount <- EditorM Int -> YiM Int
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Int -> YiM Int) -> EditorM Int -> YiM Int
forall a b. (a -> b) -> a -> b
$ Getting (PointedList Tab) Editor (PointedList Tab)
-> (PointedList Tab -> Int) -> EditorM Int
forall s (m :: * -> *) a b.
MonadState s m =>
Getting a s a -> (a -> b) -> m b
uses Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA PointedList Tab -> Int
forall a. PointedList a -> Int
PL.length
    Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
winCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
tabCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) YiM ()
quitEditor
    EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
tryCloseE

-- | This is a like 'closeWindow' but with emacs behaviour of C-x 0:
-- if we're trying to close the minibuffer or last buffer in the
-- editor, then just print a message warning the user about it rather
-- closing mini or quitting editor.
closeWindowEmacs :: YiM ()
closeWindowEmacs :: YiM ()
closeWindowEmacs = do
  PointedList Window
wins <- EditorM (PointedList Window) -> YiM (PointedList Window)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (PointedList Window) -> YiM (PointedList Window))
-> EditorM (PointedList Window) -> YiM (PointedList Window)
forall a b. (a -> b) -> a -> b
$ Getting (PointedList Window) Editor (PointedList Window)
-> EditorM (PointedList Window)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (PointedList Window) Editor (PointedList Window)
Lens' Editor (PointedList Window)
windowsA
  let winCount :: Int
winCount = PointedList Window -> Int
forall a. PointedList a -> Int
PL.length PointedList Window
wins
  Int
tabCount <- EditorM Int -> YiM Int
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM Int -> YiM Int) -> EditorM Int -> YiM Int
forall a b. (a -> b) -> a -> b
$ Getting (PointedList Tab) Editor (PointedList Tab)
-> (PointedList Tab -> Int) -> EditorM Int
forall s (m :: * -> *) a b.
MonadState s m =>
Getting a s a -> (a -> b) -> m b
uses Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA PointedList Tab -> Int
forall a. PointedList a -> Int
PL.length

  case () of
   ()
_ | Int
winCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
tabCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
         Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Attempt to delete sole ordinary window"
     | Window -> Bool
isMini (PointedList Window -> Window
forall a. PointedList a -> a
PL._focus PointedList Window
wins) ->
         Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Attempt to delete the minibuffer"
     | Bool
otherwise -> EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
tryCloseE

onYiVar :: (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar :: (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar Yi -> YiVar -> IO (YiVar, a)
f = do
  Yi
yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO a -> YiM a
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO a -> YiM a) -> IO a -> YiM a
forall a b. (a -> b) -> a -> b
$ MVar YiVar -> (YiVar -> IO (YiVar, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Yi -> MVar YiVar
yiVar Yi
yi) (Yi -> YiVar -> IO (YiVar, a)
f Yi
yi)

-- | Kill a given subprocess
terminateSubprocesses :: (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ())
terminateSubprocesses :: (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ())
terminateSubprocesses SubprocessInfo -> Bool
shouldTerminate Yi
_yi YiVar
var = do
  let ([(SubprocessId, SubprocessInfo)]
toKill, [(SubprocessId, SubprocessInfo)]
toKeep) =
        ((SubprocessId, SubprocessInfo) -> Bool)
-> [(SubprocessId, SubprocessInfo)]
-> ([(SubprocessId, SubprocessInfo)],
    [(SubprocessId, SubprocessInfo)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (SubprocessInfo -> Bool
shouldTerminate (SubprocessInfo -> Bool)
-> ((SubprocessId, SubprocessInfo) -> SubprocessInfo)
-> (SubprocessId, SubprocessInfo)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubprocessId, SubprocessInfo) -> SubprocessInfo
forall a b. (a, b) -> b
snd) ([(SubprocessId, SubprocessInfo)]
 -> ([(SubprocessId, SubprocessInfo)],
     [(SubprocessId, SubprocessInfo)]))
-> [(SubprocessId, SubprocessInfo)]
-> ([(SubprocessId, SubprocessInfo)],
    [(SubprocessId, SubprocessInfo)])
forall a b. (a -> b) -> a -> b
$ Map SubprocessId SubprocessInfo -> [(SubprocessId, SubprocessInfo)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map SubprocessId SubprocessInfo
 -> [(SubprocessId, SubprocessInfo)])
-> Map SubprocessId SubprocessInfo
-> [(SubprocessId, SubprocessInfo)]
forall a b. (a -> b) -> a -> b
$ YiVar -> Map SubprocessId SubprocessInfo
yiSubprocesses YiVar
var
  IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ()) -> IO [()] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(SubprocessId, SubprocessInfo)]
-> ((SubprocessId, SubprocessInfo) -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(SubprocessId, SubprocessInfo)]
toKill (((SubprocessId, SubprocessInfo) -> IO ()) -> IO [()])
-> ((SubprocessId, SubprocessInfo) -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess (ProcessHandle -> IO ())
-> ((SubprocessId, SubprocessInfo) -> ProcessHandle)
-> (SubprocessId, SubprocessInfo)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubprocessInfo -> ProcessHandle
procHandle (SubprocessInfo -> ProcessHandle)
-> ((SubprocessId, SubprocessInfo) -> SubprocessInfo)
-> (SubprocessId, SubprocessInfo)
-> ProcessHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubprocessId, SubprocessInfo) -> SubprocessInfo
forall a b. (a, b) -> b
snd
  (YiVar, ()) -> IO (YiVar, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (YiVar
var YiVar -> (YiVar -> YiVar) -> YiVar
forall a b. a -> (a -> b) -> b
& (Map SubprocessId SubprocessInfo
 -> Identity (Map SubprocessId SubprocessInfo))
-> YiVar -> Identity YiVar
Lens' YiVar (Map SubprocessId SubprocessInfo)
yiSubprocessesA ((Map SubprocessId SubprocessInfo
  -> Identity (Map SubprocessId SubprocessInfo))
 -> YiVar -> Identity YiVar)
-> Map SubprocessId SubprocessInfo -> YiVar -> YiVar
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(SubprocessId, SubprocessInfo)] -> Map SubprocessId SubprocessInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(SubprocessId, SubprocessInfo)]
toKeep, ())

-- | Start a subprocess with the given command and arguments.
startSubprocess :: FilePath
                -> [String]
                -> (Either SomeException ExitCode -> YiM x)
                -> YiM BufferRef
startSubprocess :: String
-> [String]
-> (Either SomeException ExitCode -> YiM x)
-> YiM BufferRef
startSubprocess String
cmd [String]
args Either SomeException ExitCode -> YiM x
onExit = (Yi -> YiVar -> IO (YiVar, BufferRef)) -> YiM BufferRef
forall a. (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar ((Yi -> YiVar -> IO (YiVar, BufferRef)) -> YiM BufferRef)
-> (Yi -> YiVar -> IO (YiVar, BufferRef)) -> YiM BufferRef
forall a b. (a -> b) -> a -> b
$ \Yi
yi YiVar
var -> do
        let (Editor
e', BufferRef
bufref) = Config -> EditorM BufferRef -> Editor -> (Editor, BufferRef)
forall a. Config -> EditorM a -> Editor -> (Editor, a)
runEditor
                              (Yi -> Config
yiConfig Yi
yi)
                              (Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text
"Launched process: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cmd)
                               EditorM () -> EditorM BufferRef -> EditorM BufferRef
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferId -> EditorM BufferRef
newEmptyBufferE (Text -> BufferId
MemBuffer Text
bufferName))
                              (YiVar -> Editor
yiEditor YiVar
var)
            procid :: SubprocessId
procid = YiVar -> SubprocessId
yiSubprocessIdSupply YiVar
var SubprocessId -> SubprocessId -> SubprocessId
forall a. Num a => a -> a -> a
+ SubprocessId
1
        SubprocessInfo
procinfo <- String -> [String] -> BufferRef -> IO SubprocessInfo
createSubprocess String
cmd [String]
args BufferRef
bufref
        SubprocessId
-> SubprocessInfo
-> Yi
-> (Either SomeException ExitCode -> YiM x)
-> IO ()
forall x.
SubprocessId
-> SubprocessInfo
-> Yi
-> (Either SomeException ExitCode -> YiM x)
-> IO ()
startSubprocessWatchers SubprocessId
procid SubprocessInfo
procinfo Yi
yi Either SomeException ExitCode -> YiM x
onExit
        (YiVar, BufferRef) -> IO (YiVar, BufferRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (YiVar
var YiVar -> (YiVar -> YiVar) -> YiVar
forall a b. a -> (a -> b) -> b
& (Editor -> Identity Editor) -> YiVar -> Identity YiVar
Lens' YiVar Editor
yiEditorA ((Editor -> Identity Editor) -> YiVar -> Identity YiVar)
-> Editor -> YiVar -> YiVar
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Editor
e'
                    YiVar -> (YiVar -> YiVar) -> YiVar
forall a b. a -> (a -> b) -> b
& (SubprocessId -> Identity SubprocessId) -> YiVar -> Identity YiVar
Lens' YiVar SubprocessId
yiSubprocessIdSupplyA ((SubprocessId -> Identity SubprocessId)
 -> YiVar -> Identity YiVar)
-> SubprocessId -> YiVar -> YiVar
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SubprocessId
procid
                    YiVar -> (YiVar -> YiVar) -> YiVar
forall a b. a -> (a -> b) -> b
& (Map SubprocessId SubprocessInfo
 -> Identity (Map SubprocessId SubprocessInfo))
-> YiVar -> Identity YiVar
Lens' YiVar (Map SubprocessId SubprocessInfo)
yiSubprocessesA ((Map SubprocessId SubprocessInfo
  -> Identity (Map SubprocessId SubprocessInfo))
 -> YiVar -> Identity YiVar)
-> (Map SubprocessId SubprocessInfo
    -> Map SubprocessId SubprocessInfo)
-> YiVar
-> YiVar
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SubprocessId
-> SubprocessInfo
-> Map SubprocessId SubprocessInfo
-> Map SubprocessId SubprocessInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SubprocessId
procid SubprocessInfo
procinfo
               , BufferRef
bufref)
  where
    bufferName :: Text
bufferName = [Text] -> Text
T.unwords [ Text
"output from", String -> Text
T.pack String
cmd, [String] -> Text
forall a. Show a => a -> Text
showT [String]
args ]

startSubprocessWatchers :: SubprocessId
                        -> SubprocessInfo
                        -> Yi
                        -> (Either SomeException ExitCode -> YiM x)
                        -> IO ()
startSubprocessWatchers :: SubprocessId
-> SubprocessInfo
-> Yi
-> (Either SomeException ExitCode -> YiM x)
-> IO ()
startSubprocessWatchers SubprocessId
procid SubprocessInfo
procinfo Yi
yi Either SomeException ExitCode -> YiM x
onExit =
    ((String, IO ()) -> IO ()) -> [(String, IO ())] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
labelSuffix, IO ()
run) -> do
              ThreadId
threadId <- IO () -> IO ThreadId
forkOS IO ()
run
              ThreadId -> String -> IO ()
labelThread ThreadId
threadId (SubprocessInfo -> String
procCmd SubprocessInfo
procinfo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
labelSuffix))
          ([(String
"Err", Handle -> (String -> IO ()) -> IO ()
pipeToBuffer (SubprocessInfo -> Handle
hErr SubprocessInfo
procinfo) (YiM () -> IO ()
send (YiM () -> IO ()) -> (String -> YiM ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> YiM ()
append Bool
True)) | SubprocessInfo -> Bool
separateStdErr SubprocessInfo
procinfo] [(String, IO ())] -> [(String, IO ())] -> [(String, IO ())]
forall a. [a] -> [a] -> [a]
++
           [(String
"Out", Handle -> (String -> IO ()) -> IO ()
pipeToBuffer (SubprocessInfo -> Handle
hOut SubprocessInfo
procinfo) (YiM () -> IO ()
send (YiM () -> IO ()) -> (String -> YiM ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> YiM ()
append Bool
False)),
            (String
"Exit", ProcessHandle -> IO (Either SomeException ExitCode)
waitForExit (SubprocessInfo -> ProcessHandle
procHandle SubprocessInfo
procinfo) IO (Either SomeException ExitCode)
-> (Either SomeException ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException ExitCode -> IO ()
reportExit)])
  where
    send :: YiM () -> IO ()
    send :: YiM () -> IO ()
send YiM ()
a = Yi -> IsRefreshNeeded -> [Action] -> IO ()
yiOutput Yi
yi IsRefreshNeeded
MustRefresh [YiM () -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction YiM ()
a]

    -- TODO: This 'String' here is due to 'pipeToBuffer' but I don't
    -- know how viable it would be to read from a process as Text.
    -- Probably not worse than String but needs benchmarking.
    append :: Bool -> String -> YiM ()
    append :: Bool -> String -> YiM ()
append Bool
atMark =
      EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (String -> EditorM ()) -> String -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BufferRef -> YiString -> EditorM ()
appendToBuffer Bool
atMark (SubprocessInfo -> BufferRef
bufRef SubprocessInfo
procinfo) (YiString -> EditorM ())
-> (String -> YiString) -> String -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YiString
R.fromString

    reportExit :: Either SomeException ExitCode -> IO ()
    reportExit :: Either SomeException ExitCode -> IO ()
reportExit Either SomeException ExitCode
ec = YiM () -> IO ()
send (YiM () -> IO ()) -> YiM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> String -> YiM ()
append Bool
True (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ String
"Process exited with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Either SomeException ExitCode -> String
forall a. Show a => a -> String
show Either SomeException ExitCode
ec
      SubprocessId -> YiM ()
removeSubprocess SubprocessId
procid
      YiM x -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM x -> YiM ()) -> YiM x -> YiM ()
forall a b. (a -> b) -> a -> b
$ Either SomeException ExitCode -> YiM x
onExit Either SomeException ExitCode
ec

removeSubprocess :: SubprocessId -> YiM ()
removeSubprocess :: SubprocessId -> YiM ()
removeSubprocess SubprocessId
procid = (Yi -> MVar YiVar) -> YiM (MVar YiVar)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Yi -> MVar YiVar
yiVar YiM (MVar YiVar) -> (MVar YiVar -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> YiM ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> YiM ()) -> (MVar YiVar -> IO ()) -> MVar YiVar -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar YiVar -> (YiVar -> IO YiVar) -> IO ())
-> (YiVar -> IO YiVar) -> MVar YiVar -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar YiVar -> (YiVar -> IO YiVar) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (YiVar -> IO YiVar
forall (f :: * -> *) a. Applicative f => a -> f a
pure (YiVar -> IO YiVar) -> (YiVar -> YiVar) -> YiVar -> IO YiVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map SubprocessId SubprocessInfo
 -> Identity (Map SubprocessId SubprocessInfo))
-> YiVar -> Identity YiVar
Lens' YiVar (Map SubprocessId SubprocessInfo)
yiSubprocessesA ((Map SubprocessId SubprocessInfo
  -> Identity (Map SubprocessId SubprocessInfo))
 -> YiVar -> Identity YiVar)
-> (Map SubprocessId SubprocessInfo
    -> Map SubprocessId SubprocessInfo)
-> YiVar
-> YiVar
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SubprocessId
-> Map SubprocessId SubprocessInfo
-> Map SubprocessId SubprocessInfo
forall k a. Ord k => k -> Map k a -> Map k a
M.delete SubprocessId
procid))

-- | Appends a 'R.YiString' to the given buffer.
--
-- TODO: Figure out and document the Bool here. Probably to do with
-- 'startSubprocessWatchers'.
appendToBuffer :: Bool      -- Something to do with stdout/stderr?
               -> BufferRef -- ^ Buffer to append to
               -> R.YiString  -- ^ Text to append
               -> EditorM ()
appendToBuffer :: Bool -> BufferRef -> YiString -> EditorM ()
appendToBuffer Bool
atErr BufferRef
bufref YiString
s = BufferRef -> BufferM () -> EditorM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
bufref (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
    -- We make sure stdout is always after stderr. This ensures that
    -- the output of the two pipe do not get interleaved. More
    -- importantly, GHCi prompt should always come after the error
    -- messages.
    Mark
me <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdERR")
    Mark
mo <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdOUT")
    let mms :: [Mark]
mms = if Bool
atErr then [Mark
mo, Mark
me] else [Mark
mo]
    [Mark] -> (Mark -> BufferM ()) -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Mark]
mms (Mark -> (MarkValue -> MarkValue) -> BufferM ()
`modifyMarkB` ((Direction -> Identity Direction)
-> MarkValue -> Identity MarkValue
Lens' MarkValue Direction
markGravityAA ((Direction -> Identity Direction)
 -> MarkValue -> Identity MarkValue)
-> Direction -> MarkValue -> MarkValue
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Direction
Forward))
    YiString -> Point -> BufferM ()
insertNAt YiString
s (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA (if Bool
atErr then Mark
me else Mark
mo))
    [Mark] -> (Mark -> BufferM ()) -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Mark]
mms (Mark -> (MarkValue -> MarkValue) -> BufferM ()
`modifyMarkB` ((Direction -> Identity Direction)
-> MarkValue -> Identity MarkValue
Lens' MarkValue Direction
markGravityAA ((Direction -> Identity Direction)
 -> MarkValue -> Identity MarkValue)
-> Direction -> MarkValue -> MarkValue
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Direction
Backward))

sendToProcess :: BufferRef -> String -> YiM ()
sendToProcess :: BufferRef -> String -> YiM ()
sendToProcess BufferRef
bufref String
s = do
    Yi
yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
    (SubprocessInfo -> Bool)
-> Map SubprocessId SubprocessInfo -> Maybe SubprocessInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((BufferRef -> BufferRef -> Bool
forall a. Eq a => a -> a -> Bool
== BufferRef
bufref) (BufferRef -> Bool)
-> (SubprocessInfo -> BufferRef) -> SubprocessInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubprocessInfo -> BufferRef
bufRef) (Map SubprocessId SubprocessInfo -> Maybe SubprocessInfo)
-> (YiVar -> Map SubprocessId SubprocessInfo)
-> YiVar
-> Maybe SubprocessInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiVar -> Map SubprocessId SubprocessInfo
yiSubprocesses (YiVar -> Maybe SubprocessInfo)
-> YiM YiVar -> YiM (Maybe SubprocessInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO YiVar -> YiM YiVar
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (MVar YiVar -> IO YiVar
forall a. MVar a -> IO a
readMVar (Yi -> MVar YiVar
yiVar Yi
yi)) YiM (Maybe SubprocessInfo)
-> (Maybe SubprocessInfo -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just SubprocessInfo
subProcessInfo -> IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr (SubprocessInfo -> Handle
hIn SubprocessInfo
subProcessInfo) String
s
      Maybe SubprocessInfo
Nothing -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Could not get subProcessInfo in sendToProcess"

pipeToBuffer :: Handle -> (String -> IO ()) -> IO ()
pipeToBuffer :: Handle -> (String -> IO ()) -> IO ()
pipeToBuffer Handle
h String -> IO ()
append = IO (Maybe Any) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Any) -> IO ())
-> (IO () -> IO (Maybe Any)) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe Any) -> IO (Maybe Any)
forall a. IO (Maybe a) -> IO (Maybe a)
ignoringException (IO (Maybe Any) -> IO (Maybe Any))
-> (IO () -> IO (Maybe Any)) -> IO () -> IO (Maybe Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Maybe Any)
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
_ <- Handle -> Int -> IO Bool
hWaitForInput Handle
h (-Int
1)
  String
r <- Handle -> IO String
readAvailable Handle
h
  String -> IO ()
append String
r

waitForExit :: ProcessHandle -> IO (Either SomeException ExitCode)
waitForExit :: ProcessHandle -> IO (Either SomeException ExitCode)
waitForExit ProcessHandle
ph =
    (SomeException -> IO (Either SomeException ExitCode))
-> IO (Either SomeException ExitCode)
-> IO (Either SomeException ExitCode)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\SomeException
e -> Either SomeException ExitCode -> IO (Either SomeException ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException ExitCode
forall a b. a -> Either a b
Left (SomeException
e :: SomeException))) (IO (Either SomeException ExitCode)
 -> IO (Either SomeException ExitCode))
-> IO (Either SomeException ExitCode)
-> IO (Either SomeException ExitCode)
forall a b. (a -> b) -> a -> b
$ do
      Maybe ExitCode
mec <- ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ProcessHandle
ph
      case Maybe ExitCode
mec of
          Maybe ExitCode
Nothing -> Int -> IO ()
threadDelay (Int
500Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1000) IO ()
-> IO (Either SomeException ExitCode)
-> IO (Either SomeException ExitCode)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO (Either SomeException ExitCode)
waitForExit ProcessHandle
ph
          Just ExitCode
ec -> Either SomeException ExitCode -> IO (Either SomeException ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> Either SomeException ExitCode
forall a b. b -> Either a b
Right ExitCode
ec)

withSyntax :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> syntax -> a) -> YiM ()
withSyntax :: (forall syntax. Mode syntax -> syntax -> a) -> YiM ()
withSyntax forall syntax. Mode syntax -> syntax -> a
f = do
            BufferRef
b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
            a
act <- BufferRef -> BufferM a -> YiM a
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (BufferM a -> YiM a) -> BufferM a -> YiM a
forall a b. (a -> b) -> a -> b
$ (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
forall a. (forall syntax. Mode syntax -> syntax -> a) -> BufferM a
withSyntaxB forall syntax. Mode syntax -> syntax -> a
f
            Action -> YiM ()
runAction (Action -> YiM ()) -> Action -> YiM ()
forall a b. (a -> b) -> a -> b
$ a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction a
act

userForceRefresh :: YiM ()
userForceRefresh :: YiM ()
userForceRefresh = (UI Editor -> IO ()) -> YiM ()
forall a. (UI Editor -> IO a) -> YiM a
withUI UI Editor -> IO ()
forall e. UI e -> IO ()
UI.userForceRefresh