    {-# 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