{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Yi.Keymap.Vim.Ex.Commands.BufferNew
-- License     : GPL-2
-- Maintainer  : yi-devel@googlegroups.com
-- Stability   : experimental
-- Portability : portable

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

import           Control.Applicative              (Alternative(..))
import           Control.Monad                    (void)
import qualified Data.Attoparsec.Text as P        (anyChar, char, string)
import           Data.List                        (null)
import qualified Data.Text as T                   (pack)
import           Yi.Buffer                        (BufferId (MemBuffer))
import           Yi.Editor                        (newEmptyBufferE, newTempBufferE, switchToBufferE)
import           Yi.Keymap                        (Action (EditorA))
import           Yi.Keymap.Vim.Common             (EventString)
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)
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
$ 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
$ Text -> Parser Text Text
P.string Text
"new"
    [Char]
n <- (Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Char -> Parser Text Char
P.char Char
' ') Parser Text [Char] -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text Char
P.anyChar)) Parser Text [Char] -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      ([Char]
"" [Char] -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
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
$ ExCommand
Common.pureExCommand {
        cmdShow :: Text
cmdShow = Text
"new"
      , cmdAction :: Action
cmdAction = EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA (EditorM () -> Action) -> EditorM () -> Action
forall a b. (a -> b) -> a -> b
$ do
              BufferRef
b <- if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
n
                  then EditorM BufferRef
newTempBufferE
                  else BufferId -> EditorM BufferRef
newEmptyBufferE (Text -> BufferId
MemBuffer (Text -> BufferId) -> Text -> BufferId
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
n)
              BufferRef -> EditorM ()
switchToBufferE BufferRef
b
      }