{-# 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 Getting a s a
l 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 Text
"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 Text
"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 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 Text
"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 Text
"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 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 Text
"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 Text
"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 Text
"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 Text
"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 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 Bool
w Bool
f Bool
a = ExCommand
Common.impureExCommand {
cmdShow :: Text
cmdShow = (if Bool
w then Text
"w" else Text
"")
Text -> Text -> Text
`T.append` Text
"quit"
Text -> Text -> Text
`T.append` (if Bool
a then Text
"all" else Text
"")
Text -> Text -> Text
`T.append` (if Bool
f then Text
"!" else Text
"")
, 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 = Text
"cquit"
, cmdAction :: Action
cmdAction = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (ExitCode -> YiM ()
quitEditorWithExitCode (Int -> ExitCode
ExitFailure Int
1))
}
action :: Bool -> Bool -> Bool -> YiM ()
action :: Bool -> Bool -> Bool -> YiM ()
action Bool
False Bool
False Bool
False = YiM ()
quitWindowE
action Bool
False Bool
False Bool
True = YiM ()
quitAllE
action Bool
True Bool
False Bool
False = YiM ()
viWrite YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
closeWindow
action Bool
True Bool
False Bool
True = YiM ()
saveAndQuitAllE
action Bool
False Bool
True Bool
False = YiM ()
closeWindow
action Bool
False Bool
True Bool
True = YiM ()
quitEditor
action Bool
True Bool
True Bool
False = YiM ()
viWrite YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiM ()
closeWindow
action Bool
True Bool
True Bool
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
== Int
1 Bool -> Bool -> Bool
&& Bool
nw
then Text -> YiM ()
errorEditor Text
"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
== Int
1 Bool -> Bool -> Bool
&& Int
tabCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then YiM ()
quitAllE
else YiM ()
closeWindow
quitAllE :: YiM ()
quitAllE :: YiM ()
quitAllE = do
let needsWindow :: FBuffer -> YiM (FBuffer, Bool)
needsWindow 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
Maybe (FBuffer, Bool)
Nothing -> YiM ()
quitEditor
Just (FBuffer
b, Bool
_) -> 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
$ Text
"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
<> Text
" (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