{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# language RankNTypes #-}
{-# LANGUAGE TupleSections     #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Ex.Commands.Quit
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Implements quit commands.

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
            -- if its the last window, quitting will quit the editor
            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
  -- Vim only shows the first modified buffer in the error.
  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