{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.Ex.Commands.Global (parse) where
import Control.Applicative (Alternative ((<|>)))
import Lens.Micro.Platform (use)
import Control.Monad (forM_, void, when)
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, isInfixOf, pack, snoc)
import qualified Data.Attoparsec.Text as P (anyChar, char, many', satisfy, string, try)
import Yi.Buffer
import Yi.Editor (withCurrentBuffer)
import Yi.Keymap (Action (BufferA, EditorA))
import Yi.Keymap.Vim.Common (EventString (Ev))
import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand)
import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete (parse)
import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute (parse)
import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow), evStringToExCommand)
import qualified Yi.Rope as R (toText)
import Yi.String (showT)
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
$ Parser Text Text -> Parser Text Text
forall i a. Parser i a -> Parser i a
P.try (Text -> Parser Text Text
P.string Text
"global/") 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
"g/"
Text
predicate <- String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' ((Char -> Bool) -> Parser Text Char
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'))
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
$ Char -> Parser Text Char
P.char Char
'/'
EventString
cmdString <- Text -> EventString
Ev (Text -> EventString) -> (String -> Text) -> String -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> EventString)
-> Parser Text String -> Parser Text EventString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text Char
P.anyChar
ExCommand
cmd <- case [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand
evStringToExCommand [EventString -> Maybe ExCommand]
allowedCmds EventString
cmdString of
Just ExCommand
c -> ExCommand -> Parser ExCommand
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ExCommand
c
Maybe ExCommand
_ -> String -> Parser ExCommand
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected command argument for global command."
ExCommand -> Parser ExCommand
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExCommand -> Parser ExCommand) -> ExCommand -> Parser ExCommand
forall a b. (a -> b) -> a -> b
$! Text -> ExCommand -> ExCommand
global Text
predicate ExCommand
cmd
global :: T.Text -> ExCommand -> ExCommand
global :: Text -> ExCommand -> ExCommand
global Text
p ExCommand
c = ExCommand
Common.pureExCommand {
cmdShow = "g/" <> p `T.snoc` '/' <> showT c
, cmdAction = EditorA $ do
mark <- withCurrentBuffer setMarkHereB
lineCount <- withCurrentBuffer lineCountB
forM_ (reverse [1..lineCount]) $ \Int
l -> do
Text
ln <- BufferM Text -> EditorM Text
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Text -> EditorM Text) -> BufferM Text -> EditorM Text
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
l BufferM Int -> BufferM Text -> BufferM Text
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
readLnB
Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
p Text -> Text -> Bool
`T.isInfixOf` Text
ln) (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
case ExCommand -> Action
cmdAction ExCommand
c of
BufferA BufferM a
action -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ BufferM a -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void BufferM a
action
EditorA EditorM a
action -> EditorM a -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void EditorM a
action
Action
_ -> String -> EditorM ()
forall a. HasCallStack => String -> a
error String
"Impure command as an argument to global."
withCurrentBuffer $ do
use (markPointA mark) >>= moveTo
deleteMarkB mark
}
allowedCmds :: [EventString -> Maybe ExCommand]
allowedCmds :: [EventString -> Maybe ExCommand]
allowedCmds = [EventString -> Maybe ExCommand
Delete.parse, EventString -> Maybe ExCommand
Substitute.parse]