{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

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

module Yi.Keymap.Vim.Ex.Commands.Write (parse) where

import           Control.Applicative              (Alternative ((<|>)))
import           Control.Monad                    (void, when)
import qualified Data.Attoparsec.Text             as P (anyChar, many', many1, space, string, try)
import           Data.Monoid                      ((<>))
import qualified Data.Text                        as T (Text, pack)
import           Yi.Buffer                        (BufferRef)
import           Yi.Editor                        (printMsg)
import           Yi.File                          (fwriteBufferE, viWrite, viWriteTo)
import           Yi.Keymap                        (Action (YiA), YiM)
import           Yi.Keymap.Vim.Common             (EventString)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (forAllBuffers, impureExCommand, needsSaving, parse)
import           Yi.Keymap.Vim.Ex.Types           (ExCommand (cmdAction, cmdShow))

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 Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text Text
P.string Text
"write") 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
"w")
            Parser Text Text -> Parser ExCommand -> Parser ExCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ExCommand
parseWriteAs Parser ExCommand -> Parser ExCommand -> Parser ExCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ExCommand
parseWrite)
    where parseWrite :: Parser ExCommand
parseWrite = do
            [Text]
alls <- 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")
            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 -> ExCommand
writeCmd (Bool -> ExCommand) -> Bool -> ExCommand
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
alls)

          parseWriteAs :: Parser ExCommand
parseWriteAs = do
            Parser Text [Char] -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text [Char] -> Parser Text ())
-> Parser Text [Char] -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.space
            Text
filename <- [Char] -> Text
T.pack ([Char] -> Text) -> Parser Text [Char] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text Char
P.anyChar
            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
$! Text -> ExCommand
writeAsCmd Text
filename

writeCmd :: Bool -> ExCommand
writeCmd :: Bool -> ExCommand
writeCmd Bool
allFlag = ExCommand
Common.impureExCommand {
    cmdShow :: Text
cmdShow = Text
"write" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
allFlag then Text
"all" 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
$ if Bool
allFlag
      then (BufferRef -> YiM ()) -> YiM ()
forall (m :: * -> *). MonadEditor m => (BufferRef -> m ()) -> m ()
Common.forAllBuffers BufferRef -> YiM ()
tryWriteBuffer YiM () -> YiM () -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"All files written"
      else YiM ()
viWrite
  }

writeAsCmd :: T.Text -> ExCommand
writeAsCmd :: Text -> ExCommand
writeAsCmd Text
filename = ExCommand
Common.impureExCommand {
    cmdShow :: Text
cmdShow = Text
"write " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filename
  , cmdAction :: Action
cmdAction = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (YiM () -> Action) -> YiM () -> Action
forall a b. (a -> b) -> a -> b
$ Text -> YiM ()
viWriteTo Text
filename
  }

tryWriteBuffer :: BufferRef -> YiM ()
tryWriteBuffer :: BufferRef -> YiM ()
tryWriteBuffer BufferRef
buf = do
    Bool
ns <- BufferRef -> YiM Bool
Common.needsSaving BufferRef
buf
    Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ns (YiM () -> YiM ()) -> (YiM Bool -> YiM ()) -> YiM Bool -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiM Bool -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM Bool -> YiM ()) -> YiM Bool -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> YiM Bool
fwriteBufferE BufferRef
buf