{-# 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 :: forall a b (f :: * -> *) s.
MonadState s f =>
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 a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string Text
"x"
        bangs <- Parser Text Char -> Parser Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Char -> Parser Text Char
P.char Char
'!')
        return (quit True (not $ null bangs) 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 a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
P.string Text
"cq"
        ExCommand -> Parser ExCommand
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ExCommand
hardExitWithError
    , do
        ws <- Parser Text Char -> Parser Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Char -> Parser Text Char
P.char Char
'w')
        void $ P.try ( P.string "quit") <|> P.string "q"
        as <- P.many' (P.try ( P.string "all") <|> P.string "a")
        bangs <- P.many' (P.char '!')
        return $! quit (not $ null ws) (not $ null bangs) (not $ null as)
    ]

quit :: Bool -> Bool -> Bool -> ExCommand
quit :: Bool -> Bool -> Bool -> ExCommand
quit Bool
w Bool
f Bool
a = ExCommand
Common.impureExCommand {
    cmdShow = (if w then "w" else "")
              `T.append` "quit"
              `T.append` (if a then "all" else "")
              `T.append` (if f then "!" else "")
  , cmdAction = YiA $ action w f a
  }

hardExitWithError :: ExCommand
hardExitWithError :: ExCommand
hardExitWithError = ExCommand
Common.impureExCommand {
    cmdShow = "cquit"
  , cmdAction = YiA (quitEditorWithExitCode (ExitFailure 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 a b. YiM a -> YiM b -> YiM b
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 a b. YiM a -> YiM b -> YiM b
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
    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 a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufferRef -> YiM Bool
Common.needsSaving
    ws <- withEditor $ use currentWindowA >>= windowsOnBufferE . bufkey
    if length ws == 1 && nw
       then errorEditor "No write since last change (add ! to override)"
       else do
         winCount <- withEditor $ uses windowsA PL.length
         tabCount <- withEditor $ uses tabsA PL.length
         if winCount == 1 && tabCount == 1
            -- if its the last window, quitting will quit the editor
            then quitAllE
            else 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
  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 a b. YiM a -> (a -> YiM b) -> YiM b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FBuffer -> YiM (FBuffer, Bool)
needsWindow
  -- Vim only shows the first modified buffer in the error.
  case find snd bs of
      Maybe (FBuffer, Bool)
Nothing -> YiM ()
quitEditor
      Just (FBuffer
b, Bool
_) -> do
          bufferName <- EditorM (Maybe FilePath) -> YiM (Maybe FilePath)
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (Maybe FilePath) -> YiM (Maybe FilePath))
-> EditorM (Maybe FilePath) -> YiM (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ BufferRef -> BufferM (Maybe FilePath) -> EditorM (Maybe FilePath)
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer (FBuffer -> BufferRef
bkey FBuffer
b) (BufferM (Maybe FilePath) -> EditorM (Maybe FilePath))
-> BufferM (Maybe FilePath) -> EditorM (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file
          errorEditor $ "No write since last change for buffer "
                        <> showT bufferName
                        <> " (add ! to override)"

saveAndQuitAllE :: YiM ()
saveAndQuitAllE :: YiM ()
saveAndQuitAllE = do
    succeed <- YiM Bool
fwriteAllY
    when succeed quitEditor