{-# 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
  evs <- EditorM [Event] -> YiM [Event]
forall a. EditorM a -> YiM a
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
  logPutStrLn $ ">>> interactively" <> showEvs evs
  withEditor $ buffersA %= (fmap $ undosA %~ addChangeU InteractivePoint)
  mapM_ runAction action
  withEditor $ killringA %= krEndCmd
  when (isRefreshNeeded == MustRefresh) refreshEditor
  logPutStrLn "<<<"
  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"
    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, runYi) <- mdo
        let 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 a b. YiM a -> YiM b -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
refreshEditor

            inF []     = () -> IO ()
forall a. a -> IO a
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
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 ()
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        = 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 <- uiStart cfg inF (outF MustRefresh) editor
        return (ui, runYi)

    runYi loadPersistentState

    runYi $ do
      if isNothing st
        -- process options if booting for the first time
        then postActions NoNeedToRefresh $ startActions cfg
        -- otherwise: recover the mode of buffers
        else withEditor $ buffersA.mapped %= recoverMode (modeTable cfg)
      postActions NoNeedToRefresh $ initialActions cfg ++ [makeAction showErrors]

    runYi refreshEditor

    UI.main 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 (ZonkAny 1) -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode Mode (ZonkAny 1)
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 <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask; liftBase $ yiOutput yi refreshNeeded actions

-- | Display the errors buffer in a new split window if it exists.
showErrors :: YiM ()
showErrors :: YiM ()
showErrors = EditorM () -> YiM ()
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
               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*"
               when bs $ do 
                 splitE
                 switchToBufferWithNameE "*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 <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
  (userActions, _p') <- withCurrentBuffer $ do
    keymap <- gets (withMode0 modeKeymap)
    p0 <- use keymapProcessA
    let 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 Event -> KeymapProcess -> KeymapProcess
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 -> KeymapProcess
forall w ev a. Eq w => I ev w a -> P ev w
mkAutomaton Keymap
km)
        p = case KeymapProcess -> InteractState Event Action
forall w event. Eq w => P event w -> InteractState event w
computeState KeymapProcess
p0 of
              InteractState Event Action
Dead  -> KeymapProcess
freshP
              InteractState Event Action
_     -> KeymapProcess
p0
        (actions, p') = processOneEvent p ev
        state = KeymapProcess -> InteractState Event Action
forall w event. Eq w => P event w -> InteractState event w
computeState KeymapProcess
p'
        ambiguous = case InteractState Event Action
state of
            Ambiguous [(Int, Action, KeymapProcess)]
_ -> Bool
True
            InteractState Event Action
_ -> Bool
False
    keymapProcessA .= (if ambiguous then freshP else p')
    let 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
                      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
                      printMsg ("Unrecognized input: " <> showEvs (evs' ++ [ev]))]
          InteractState Event Action
_ -> [Action]
actions

        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]

    return (actions0 ++ actions1, p')

  let decay, pendingFeedback :: 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 = 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 a. [a] -> 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 = [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 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 a b. YiM a -> YiM b -> YiM b
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 a b. (a -> b) -> [a] -> [b]
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
  now <- IO UTCTime
getCurrentTime
  -- Find out if any file was modified "behind our back" by
  -- other processes.
  newBuffers <- forM (buffers e0) $ \FBuffer
b ->
    let nothing :: IO (FBuffer, Maybe a)
nothing = (FBuffer, Maybe a) -> IO (FBuffer, Maybe a)
forall a. a -> IO 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 a. Eq a => a -> PointedList a -> 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
Lens' FBuffer BufferId
identA of
         FileBuffer String
fname -> do
            fe <- String -> IO Bool
doesFileExist String
fname
            if not fe then nothing else do
                modTime <- fileModTime fname
                if b ^. lastSyncTimeA < modTime
                   then if isUnchangedBuffer b
                     then R.readFile fname >>= return . \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
Lens' FBuffer 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 return (b, Just msg2)
                   else 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
  return $ case getFirst (foldMap (First . snd) 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 = fmap fst 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 a b. (a -> b) -> Map BufferRef a -> Map BufferRef b
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)
Lens' FBuffer (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 a. Seq a -> 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 a b. (a -> b) -> Map BufferRef a -> Map BufferRef b
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 a. PointedList a -> [a]
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 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
                                        forM ws $ flip withWindowE 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) Editor
e4

        e7 <- (if Config -> Bool
configCheckExternalChangesObsessively Config
cfg
               then Editor -> IO Editor
checkFileChanges
               else Editor -> IO Editor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) (YiVar -> Editor
yiEditor YiVar
var) IO Editor -> (Editor -> IO Editor) -> IO Editor
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Editor -> IO Editor
forall a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             -- Adjust point according to the current layout;
             Editor -> IO Editor
forall a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             Editor -> IO Editor
forall a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
             -- Clear "pending updates" and "followUp" from buffers.
             Editor -> IO Editor
forall a. a -> IO a
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 a b. (a -> b) -> Map BufferRef a -> Map BufferRef b
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.refresh (yiUi yi) e7
        -- Terminate stale processes.
        terminateSubprocesses (staleProcess $ buffers e7) yi var {yiEditor = e7}
  where
    clearUpdates :: FBuffer -> FBuffer
clearUpdates = (Seq UIUpdate -> Identity (Seq UIUpdate))
-> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c (Seq UIUpdate)
Lens' FBuffer (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)
Lens' FBuffer (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: variants 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
    (_,out,_err) <- IO (ExitCode, String, String) -> YiM (ExitCode, String, String)
forall α. IO α -> YiM α
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
    return (chomp "\n" out)

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

-- | Same as 'Yi.Editor.printMsg', but do nothing instead of printing @()@
msgEditor :: T.Text -> YiM ()
msgEditor :: Text -> YiM ()
msgEditor Text
"()" = () -> YiM ()
forall a. a -> YiM a
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 a b. YiM a -> (a -> YiM b) -> YiM b
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 a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM a
act YiM a -> (a -> YiM ()) -> YiM ()
forall a b. YiM a -> (a -> YiM b) -> YiM b
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 a b. YiM a -> (a -> YiM b) -> YiM b
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
    winCount <- EditorM Int -> YiM Int
forall a. EditorM a -> YiM a
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
    tabCount <- withEditor $ uses tabsA PL.length
    when (winCount == 1 && tabCount == 1) quitEditor
    withEditor 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
  wins <- EditorM (PointedList Window) -> YiM (PointedList Window)
forall a. EditorM a -> YiM a
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 = PointedList Window -> Int
forall a. PointedList a -> Int
PL.length PointedList Window
wins
  tabCount <- withEditor $ uses tabsA 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 a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
tryCloseE

onYiVar :: (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar :: forall a. (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar Yi -> YiVar -> IO (YiVar, a)
f = do
  yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
  io $ modifyMVar (yiVar yi) (f 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 a. a -> IO a
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 :: forall x.
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 a b. EditorM a -> EditorM b -> EditorM b
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
        procinfo <- String -> [String] -> BufferRef -> IO SubprocessInfo
createSubprocess String
cmd [String]
args BufferRef
bufref
        startSubprocessWatchers procid procinfo yi onExit
        return (var & yiEditorA .~ e'
                    & yiSubprocessIdSupplyA .~ procid
                    & yiSubprocessesA %~ M.insert procid procinfo
               , 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 :: forall x.
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 <- IO () -> IO ThreadId
forkOS IO ()
run
              labelThread threadId (procCmd procinfo ++ 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 a b. IO a -> (a -> IO b) -> IO b
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 a. EditorM a -> YiM a
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 a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> YiM ()
forall α. 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 a. a -> IO a
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.
    me <- Maybe String -> BufferM Mark
getMarkB (String -> Maybe String
forall a. a -> Maybe a
Just String
"StdERR")
    mo <- getMarkB (Just "StdOUT")
    let mms = if Bool
atErr then [Mark
mo, Mark
me] else [Mark
mo]
    forM_ mms (`modifyMarkB` (markGravityAA .~ Forward))
    insertNAt s =<< use (markPointA (if atErr then me else mo))
    forM_ mms (`modifyMarkB` (markGravityAA .~ Backward))

sendToProcess :: BufferRef -> String -> YiM ()
sendToProcess :: BufferRef -> String -> YiM ()
sendToProcess BufferRef
bufref String
s = do
    yi <- YiM Yi
forall r (m :: * -> *). MonadReader r m => m r
ask
    find ((== bufref) . bufRef) . yiSubprocesses <$> liftBase (readMVar (yiVar yi)) >>= \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 (ZonkAny 0)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe (ZonkAny 0)) -> IO ())
-> (IO () -> IO (Maybe (ZonkAny 0))) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (ZonkAny 0)) -> IO (Maybe (ZonkAny 0))
forall a. IO (Maybe a) -> IO (Maybe a)
ignoringException (IO (Maybe (ZonkAny 0)) -> IO (Maybe (ZonkAny 0)))
-> (IO () -> IO (Maybe (ZonkAny 0)))
-> IO ()
-> IO (Maybe (ZonkAny 0))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Maybe (ZonkAny 0))
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  _ <- Handle -> Int -> IO Bool
hWaitForInput Handle
h (-Int
1)
  r <- readAvailable h
  append 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 a. a -> IO a
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
      mec <- ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ProcessHandle
ph
      case 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 a b. IO a -> IO b -> IO b
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 a. a -> IO a
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 x a.
(Show x, YiAction a x) =>
(forall syntax. Mode syntax -> syntax -> a) -> YiM ()
withSyntax forall syntax. Mode syntax -> syntax -> a
f = do
            b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
            act <- withGivenBuffer b $ withSyntaxB f
            runAction $ makeAction 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