{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# language RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.Ex.Commands.Quit (parse) where
import Control.Applicative (Alternative ((<|>)))
import Lens.Micro.Platform (use, Getting)
import Control.Monad (void, when)
import Control.Monad.State.Class (MonadState)
import qualified Data.Attoparsec.Text as P (char, choice, many', string, try)
import Data.Foldable (find)
import qualified Data.List.PointedList.Circular as PL (length)
import Data.Monoid ((<>))
import qualified Data.Text as T (append)
import System.Exit (ExitCode (ExitFailure))
import Yi.Buffer (bkey, file)
import Yi.Core (closeWindow, errorEditor, quitEditor,
quitEditorWithExitCode)
import Yi.Editor
import Yi.File (deservesSave, fwriteAllY, viWrite)
import Yi.Keymap (Action (YiA), YiM, readEditor)
import Yi.Keymap.Vim.Common (EventString)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, needsSaving, parse)
import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow))
import Yi.Monad (gets)
import Yi.String (showT)
import Yi.Window (bufkey)
uses :: forall a b f s. MonadState s f => Getting a s a -> (a -> b) -> f b
uses :: Getting a s a -> (a -> b) -> f b
uses l :: Getting a s a
l f :: a -> b
f = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting a s a -> f a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting a s a
l
parse :: EventString -> Maybe ExCommand
parse :: EventString -> Maybe ExCommand
parse = Parser ExCommand -> EventString -> Maybe ExCommand
Common.parse (Parser ExCommand -> EventString -> Maybe ExCommand)
-> Parser ExCommand -> EventString -> Maybe ExCommand
forall a b. (a -> b) -> a -> b
$ [Parser ExCommand] -> Parser ExCommand
forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice
[ do
Parser Text Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string "xit") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string "x"
[Char]
bangs <- Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Char -> Parser Text Char
P.char '!')
ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Bool -> ExCommand
quit Bool
True (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
bangs) Bool
False)
, do
Parser Text Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text Text
P.string "cquit") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string "cq"
ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return ExCommand
hardExitWithError
, do
[Char]
ws <- Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Char -> Parser Text Char
P.char 'w')
Parser Text Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string "quit") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string "q"
[Text]
as <- Parser Text Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try ( Text -> Parser Text Text
P.string "all") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string "a")
[Char]
bangs <- Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Char -> Parser Text Char
P.char '!')
ExCommand -> Parser ExCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$! Bool -> Bool -> Bool -> ExCommand
quit (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ws) (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
bangs) (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
as)
]
quit :: Bool -> Bool -> Bool -> ExCommand
quit :: Bool -> Bool -> Bool -> ExCommand
quit w :: Bool
w f :: Bool
f a :: Bool
a = ExCommand
Common.impureExCommand {
cmdShow :: Text
cmdShow = (if Bool
w then "w" else "")
Text -> Text -> Text
`T.append` "quit"
Text -> Text -> Text
`T.append` (if Bool
a then "all" else "")
Text -> Text -> Text
`T.append` (if Bool
f then "!" else "")
, cmdAction :: Action
cmdAction = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (YiM () -> Action) -> YiM () -> Action
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> YiM ()
action Bool
w Bool
f Bool
a
}
hardExitWithError :: ExCommand
hardExitWithError :: ExCommand
hardExitWithError = ExCommand
Common.impureExCommand {
cmdShow :: Text
cmdShow = "cquit"
, cmdAction :: Action
cmdAction = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (ExitCode -> YiM ()
quitEditorWithExitCode (Int -> ExitCode
ExitFailure 1))
}
action :: Bool -> Bool -> Bool -> YiM ()
action :: Bool -> Bool -> Bool -> YiM ()
action False False False = YiM ()
quitWindowE
action False False True = YiM ()
quitAllE
action True False False = YiM ()
viWrite YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
closeWindow
action True False True = YiM ()
saveAndQuitAllE
action False True False = YiM ()
closeWindow
action False True True = YiM ()
quitEditor
action True True False = YiM ()
viWrite YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
closeWindow
action True True True = YiM ()
saveAndQuitAllE
quitWindowE :: YiM ()
quitWindowE :: YiM ()
quitWindowE = do
Bool
nw <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer YiM BufferRef -> (BufferRef -> YiM Bool) -> YiM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufferRef -> YiM Bool
Common.needsSaving
[Window]
ws <- EditorM [Window] -> YiM [Window]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM [Window] -> YiM [Window])
-> EditorM [Window] -> YiM [Window]
forall a b. (a -> b) -> a -> b
$ Getting Window Editor Window -> EditorM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window Editor Window
Lens' Editor Window
currentWindowA EditorM Window -> (Window -> EditorM [Window]) -> EditorM [Window]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufferRef -> EditorM [Window]
windowsOnBufferE (BufferRef -> EditorM [Window])
-> (Window -> BufferRef) -> Window -> EditorM [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> BufferRef
bufkey
if [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Bool
nw
then Text -> YiM ()
errorEditor "No write since last change (add ! to override)"
else 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 a b (f :: * -> *) s.
MonadState s f =>
Getting a s a -> (a -> b) -> f 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 a b (f :: * -> *) s.
MonadState s f =>
Getting a s a -> (a -> b) -> f b
uses Getting (PointedList Tab) Editor (PointedList Tab)
Lens' Editor (PointedList Tab)
tabsA PointedList Tab -> Int
forall a. PointedList a -> Int
PL.length
if Int
winCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
tabCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
then YiM ()
quitAllE
else YiM ()
closeWindow
quitAllE :: YiM ()
quitAllE :: YiM ()
quitAllE = do
let needsWindow :: FBuffer -> YiM (FBuffer, Bool)
needsWindow b :: FBuffer
b = (FBuffer
b,) (Bool -> (FBuffer, Bool)) -> YiM Bool -> YiM (FBuffer, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FBuffer -> YiM Bool
deservesSave FBuffer
b
[(FBuffer, Bool)]
bs <- (Editor -> [FBuffer]) -> YiM [FBuffer]
forall (m :: * -> *) a. MonadEditor m => (Editor -> a) -> m a
readEditor Editor -> [FBuffer]
bufferSet YiM [FBuffer]
-> ([FBuffer] -> YiM [(FBuffer, Bool)]) -> YiM [(FBuffer, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FBuffer -> YiM (FBuffer, Bool))
-> [FBuffer] -> YiM [(FBuffer, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FBuffer -> YiM (FBuffer, Bool)
needsWindow
case ((FBuffer, Bool) -> Bool)
-> [(FBuffer, Bool)] -> Maybe (FBuffer, Bool)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (FBuffer, Bool) -> Bool
forall a b. (a, b) -> b
snd [(FBuffer, Bool)]
bs of
Nothing -> YiM ()
quitEditor
Just (b :: FBuffer
b, _) -> do
Maybe [Char]
bufferName <- EditorM (Maybe [Char]) -> YiM (Maybe [Char])
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (Maybe [Char]) -> YiM (Maybe [Char]))
-> EditorM (Maybe [Char]) -> YiM (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ BufferRef -> BufferM (Maybe [Char]) -> EditorM (Maybe [Char])
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer (FBuffer -> BufferRef
bkey FBuffer
b) (BufferM (Maybe [Char]) -> EditorM (Maybe [Char]))
-> BufferM (Maybe [Char]) -> EditorM (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe [Char]) -> BufferM (Maybe [Char])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe [Char]
file
Text -> YiM ()
errorEditor (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ "No write since last change for buffer "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe [Char] -> Text
forall a. Show a => a -> Text
showT Maybe [Char]
bufferName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (add ! to override)"
saveAndQuitAllE :: YiM ()
saveAndQuitAllE :: YiM ()
saveAndQuitAllE = do
Bool
succeed <- YiM Bool
fwriteAllY
Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
succeed YiM ()
quitEditor