{-# 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ExCommand
c
Maybe ExCommand
_ -> String -> Parser ExCommand
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected command argument for global command."
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 -> ExCommand
global Text
predicate ExCommand
cmd
global :: T.Text -> ExCommand -> ExCommand
global :: Text -> ExCommand -> ExCommand
global Text
p ExCommand
c = ExCommand
Common.pureExCommand {
cmdShow :: Text
cmdShow = Text
"g/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Char -> Text
`T.snoc` Char
'/' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExCommand -> Text
forall a. Show a => a -> Text
showT ExCommand
c
, 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
Mark
mark <- BufferM Mark -> EditorM Mark
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM Mark
setMarkHereB
Int
lineCount <- BufferM Int -> EditorM Int
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM Int
lineCountB
[Int] -> (Int -> EditorM ()) -> EditorM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
1..Int
lineCount]) ((Int -> EditorM ()) -> EditorM ())
-> (Int -> EditorM ()) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \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 (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."
BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Mark -> Lens' FBuffer Point
markPointA Mark
mark) BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
moveTo
Mark -> BufferM ()
deleteMarkB Mark
mark
}
allowedCmds :: [EventString -> Maybe ExCommand]
allowedCmds :: [EventString -> Maybe ExCommand]
allowedCmds = [EventString -> Maybe ExCommand
Delete.parse, EventString -> Maybe ExCommand
Substitute.parse]