{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Core
(
startEditor
, quitEditor
, quitEditorWithExitCode
, refreshEditor
, suspendEditor
, userForceRefresh
, errorEditor
, closeWindow
, closeWindowEmacs
, runProcessWithInput
, startSubprocess
, sendToProcess
, 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)
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 ()
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"
let editor :: Editor
editor = Editor -> Maybe Editor -> Editor
forall a. a -> Maybe a -> a
fromMaybe Editor
emptyEditor Maybe Editor
st
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
then IsRefreshNeeded -> [Action] -> YiM ()
postActions IsRefreshNeeded
NoNeedToRefresh ([Action] -> YiM ()) -> [Action] -> YiM ()
forall a b. (a -> b) -> a -> b
$ Config -> [Action]
startActions Config
cfg
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
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
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*"
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)
quitEditor :: YiM ()
quitEditor :: YiM ()
quitEditor = ExitCode -> YiM ()
quitEditorWithExitCode ExitCode
ExitSuccess
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))
checkFileChanges :: Editor -> IO Editor
checkFileChanges :: Editor -> IO Editor
checkFileChanges Editor
e0 = do
UTCTime
now <- IO UTCTime
getCurrentTime
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
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
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 =
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
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]
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
(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
>>=
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
>>=
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
>>=
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))
UI Editor -> Editor -> IO ()
forall e. UI e -> e -> IO ()
UI.refresh (Yi -> UI Editor
yiUi Yi
yi) Editor
e7
(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
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)
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
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)
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
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
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
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)
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, ())
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]
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))
appendToBuffer :: Bool
-> BufferRef
-> R.YiString
-> 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
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