{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.NormalOperatorPendingMap
(defNormalOperatorPendingMap) where
import Control.Monad (void, when)
import Data.Char (isDigit)
import Data.List (isPrefixOf)
import Data.Maybe (fromJust, fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (init, last, pack, snoc, unpack)
import Yi.Buffer hiding (Insert)
import Yi.Editor (getEditorDyn, withCurrentBuffer)
import Yi.Keymap.Keys (Key (KEsc), spec)
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Motion
import Yi.Keymap.Vim.Operator
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion)
import Yi.Keymap.Vim.TextObject
import Yi.Keymap.Vim.Utils (mkBindingE)
defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]
defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]
defNormalOperatorPendingMap [VimOperator]
operators = [[VimOperator] -> VimBinding
textObject [VimOperator]
operators, VimBinding
escBinding]
textObject :: [VimOperator] -> VimBinding
textObject :: [VimOperator] -> VimBinding
textObject [VimOperator]
operators = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
where
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs VimState
vs = case VimState -> VimMode
vsMode VimState
vs of
NormalOperatorPending OperatorName
_ -> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a. a -> MatchResult a
WholeMatch (EditorM RepeatToken -> MatchResult (EditorM RepeatToken))
-> EditorM RepeatToken -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> a -> b
$ EventString -> EditorM RepeatToken
action EventString
evs
VimMode
_ -> MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
action :: EventString -> EditorM RepeatToken
action (Ev Text
evs) = do
VimState
currentState <- EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
let partial :: EventString
partial = VimState -> EventString
vsTextObjectAccumulator VimState
currentState
opChar :: EventString
opChar = 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) -> String -> EventString
forall a b. (a -> b) -> a -> b
$ VimOperator -> String
lastCharForOperator VimOperator
op
op :: VimOperator
op = Maybe VimOperator -> VimOperator
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe VimOperator -> VimOperator)
-> Maybe VimOperator -> VimOperator
forall a b. (a -> b) -> a -> b
$ [VimOperator] -> OperatorName -> Maybe VimOperator
stringToOperator [VimOperator]
operators OperatorName
opname
(NormalOperatorPending OperatorName
opname) = VimState -> VimMode
vsMode VimState
currentState
let evs' :: Text
evs' = if OperatorName
opname OperatorName -> OperatorName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> OperatorName
Op Text
"c" Bool -> Bool -> Bool
&& Text -> Char
T.last Text
evs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w' Bool -> Bool -> Bool
&&
(case EventString -> String -> OperandParseResult
parseOperand EventString
opChar (Text -> String
evr Text
evs) of
JustMove CountedMove
_ -> Bool
True
OperandParseResult
_ -> Bool
False)
then Text -> Text
T.init Text
evs Text -> Char -> Text
`T.snoc` Char
'e'
else Text
evs
evr :: Text -> String
evr Text
x = Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> String) -> EventString -> String
forall a b. (a -> b) -> a -> b
$ EventString
partial EventString -> EventString -> EventString
forall a. Semigroup a => a -> a -> a
<> Text -> EventString
Ev Text
x
operand :: OperandParseResult
operand = EventString -> String -> OperandParseResult
parseOperand EventString
opChar (Text -> String
evr Text
evs')
case OperandParseResult
operand of
OperandParseResult
NoOperand -> do
EditorM ()
dropTextObjectAccumulatorE
EditorM ()
resetCountE
VimMode -> EditorM ()
switchModeE VimMode
Normal
RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Drop
OperandParseResult
PartialOperand -> do
EventString -> EditorM ()
accumulateTextObjectEventE (Text -> EventString
Ev Text
evs)
RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Continue
OperandParseResult
_ -> do
Int
count <- EditorM Int
getCountE
EditorM ()
dropTextObjectAccumulatorE
RepeatToken
token <- case OperandParseResult
operand of
JustTextObject cto :: CountedTextObject
cto@(CountedTextObject Int
n TextObject
_) -> do
Maybe Int -> EditorM ()
normalizeCountE (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
operatorApplyToTextObjectE VimOperator
op Int
1 (CountedTextObject -> EditorM RepeatToken)
-> CountedTextObject -> EditorM RepeatToken
forall a b. (a -> b) -> a -> b
$
Int -> CountedTextObject -> CountedTextObject
changeTextObjectCount (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) CountedTextObject
cto
JustMove (CountedMove Maybe Int
n Move
m) -> do
Maybe Int
mcount <- EditorM (Maybe Int)
getMaybeCountE
Maybe Int -> EditorM ()
normalizeCountE Maybe Int
n
StyledRegion
region <- BufferM StyledRegion -> EditorM StyledRegion
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM StyledRegion -> EditorM StyledRegion)
-> BufferM StyledRegion -> EditorM StyledRegion
forall a b. (a -> b) -> a -> b
$ CountedMove -> BufferM StyledRegion
regionOfMoveB (CountedMove -> BufferM StyledRegion)
-> CountedMove -> BufferM StyledRegion
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Move -> CountedMove
CountedMove (Maybe Int -> Maybe Int -> Maybe Int
forall a. Num a => Maybe a -> Maybe a -> Maybe a
maybeMult Maybe Int
mcount Maybe Int
n) Move
m
VimOperator -> Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE VimOperator
op Int
1 StyledRegion
region
JustOperator Int
n RegionStyle
style -> do
Maybe Int -> EditorM ()
normalizeCountE (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
Int
normalizedCount <- EditorM Int
getCountE
StyledRegion
region <- BufferM StyledRegion -> EditorM StyledRegion
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM StyledRegion -> EditorM StyledRegion)
-> BufferM StyledRegion -> EditorM StyledRegion
forall a b. (a -> b) -> a -> b
$ Int -> RegionStyle -> BufferM StyledRegion
regionForOperatorLineB Int
normalizedCount RegionStyle
style
Point
curPoint <- BufferM Point -> EditorM Point
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM Point
pointB
RepeatToken
token <- VimOperator -> Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE VimOperator
op Int
1 StyledRegion
region
Bool -> EditorM () -> EditorM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OperatorName
opname OperatorName -> OperatorName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> OperatorName
Op Text
"y") (EditorM () -> EditorM ()) -> EditorM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Point -> BufferM ()
moveTo Point
curPoint
RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
token
OperandParseResult
_ -> String -> EditorM RepeatToken
forall a. HasCallStack => String -> a
error String
"can't happen"
EditorM ()
resetCountE
RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
token
regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion
regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion
regionForOperatorLineB Int
n RegionStyle
style = StyledRegion -> BufferM StyledRegion
normalizeRegion (StyledRegion -> BufferM StyledRegion)
-> BufferM StyledRegion -> BufferM StyledRegion
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RegionStyle -> Region -> StyledRegion
StyledRegion RegionStyle
style (Region -> StyledRegion) -> BufferM Region -> BufferM StyledRegion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Region -> BufferM Region
forall a. BufferM a -> BufferM a
savingPointB (do
Point
current <- BufferM Point
pointB
if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then do
BufferM ()
firstNonSpaceB
Point
p0 <- BufferM Point
pointB
Region -> BufferM Region
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> BufferM Region) -> Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$! Point -> Point -> Region
mkRegion Point
p0 Point
current
else do
BufferM Int -> BufferM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BufferM Int -> BufferM ()) -> BufferM Int -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
lineMoveRel (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
BufferM ()
moveToEol
BufferM ()
rightB
BufferM ()
firstNonSpaceB
Point
p1 <- BufferM Point
pointB
Region -> BufferM Region
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> BufferM Region) -> Region -> BufferM Region
forall a b. (a -> b) -> a -> b
$! Point -> Point -> Region
mkRegion Point
current Point
p1)
escBinding :: VimBinding
escBinding :: VimBinding
escBinding = VimMode
-> RepeatToken
-> (Event, EditorM (), VimState -> VimState)
-> VimBinding
mkBindingE VimMode
ReplaceSingleChar RepeatToken
Drop (Key -> Event
spec Key
KEsc, () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), VimState -> VimState
resetCount (VimState -> VimState)
-> (VimState -> VimState) -> VimState -> VimState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimMode -> VimState -> VimState
switchMode VimMode
Normal)
data OperandParseResult
= JustTextObject !CountedTextObject
| JustMove !CountedMove
| JustOperator !Int !RegionStyle
| PartialOperand
| NoOperand
parseOperand :: EventString -> String -> OperandParseResult
parseOperand :: EventString -> String -> OperandParseResult
parseOperand EventString
opChar String
s = Maybe Int
-> (RegionStyle -> RegionStyle)
-> EventString
-> String
-> OperandParseResult
parseCommand Maybe Int
mcount RegionStyle -> RegionStyle
styleMod EventString
opChar String
commandString
where (Maybe Int
mcount, String
styleModString, String
commandString) = String -> (Maybe Int, String, String)
splitCountModifierCommand String
s
styleMod :: RegionStyle -> RegionStyle
styleMod = case String
styleModString of
String
"" -> RegionStyle -> RegionStyle
forall a. a -> a
id
String
"V" -> RegionStyle -> RegionStyle -> RegionStyle
forall a b. a -> b -> a
const RegionStyle
LineWise
String
"<C-v>" -> RegionStyle -> RegionStyle -> RegionStyle
forall a b. a -> b -> a
const RegionStyle
Block
String
"v" -> \RegionStyle
style -> case RegionStyle
style of
RegionStyle
Exclusive -> RegionStyle
Inclusive
RegionStyle
_ -> RegionStyle
Exclusive
String
_ -> String -> RegionStyle -> RegionStyle
forall a. HasCallStack => String -> a
error String
"Can't happen"
parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)
-> EventString -> String -> OperandParseResult
parseCommand :: Maybe Int
-> (RegionStyle -> RegionStyle)
-> EventString
-> String
-> OperandParseResult
parseCommand Maybe Int
_ RegionStyle -> RegionStyle
_ EventString
_ String
"" = OperandParseResult
PartialOperand
parseCommand Maybe Int
_ RegionStyle -> RegionStyle
_ EventString
_ String
"i" = OperandParseResult
PartialOperand
parseCommand Maybe Int
_ RegionStyle -> RegionStyle
_ EventString
_ String
"a" = OperandParseResult
PartialOperand
parseCommand Maybe Int
_ RegionStyle -> RegionStyle
_ EventString
_ String
"g" = OperandParseResult
PartialOperand
parseCommand Maybe Int
n RegionStyle -> RegionStyle
sm EventString
o String
s | String
o' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s = Int -> RegionStyle -> OperandParseResult
JustOperator (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
n) (RegionStyle -> RegionStyle
sm RegionStyle
LineWise)
where o' :: String
o' = Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> String) -> EventString -> String
forall a b. (a -> b) -> a -> b
$ EventString
o
parseCommand Maybe Int
n RegionStyle -> RegionStyle
sm EventString
_ String
"0" =
let m :: Move
m = RegionStyle -> Bool -> (Maybe Int -> BufferM ()) -> Move
Move RegionStyle
Exclusive Bool
False (BufferM () -> Maybe Int -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
moveToSol)
in CountedMove -> OperandParseResult
JustMove (Maybe Int -> Move -> CountedMove
CountedMove Maybe Int
n ((RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle RegionStyle -> RegionStyle
sm Move
m))
parseCommand Maybe Int
n RegionStyle -> RegionStyle
sm EventString
_ String
s = case EventString -> MatchResult Move
stringToMove (EventString -> MatchResult Move)
-> (Text -> EventString) -> Text -> MatchResult Move
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EventString
Ev (Text -> MatchResult Move) -> Text -> MatchResult Move
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
WholeMatch Move
m -> CountedMove -> OperandParseResult
JustMove (CountedMove -> OperandParseResult)
-> CountedMove -> OperandParseResult
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Move -> CountedMove
CountedMove Maybe Int
n (Move -> CountedMove) -> Move -> CountedMove
forall a b. (a -> b) -> a -> b
$ (RegionStyle -> RegionStyle) -> Move -> Move
changeMoveStyle RegionStyle -> RegionStyle
sm Move
m
MatchResult Move
PartialMatch -> OperandParseResult
PartialOperand
MatchResult Move
NoMatch -> case String -> MatchResult TextObject
stringToTextObject String
s of
WholeMatch TextObject
to -> CountedTextObject -> OperandParseResult
JustTextObject (CountedTextObject -> OperandParseResult)
-> CountedTextObject -> OperandParseResult
forall a b. (a -> b) -> a -> b
$ Int -> TextObject -> CountedTextObject
CountedTextObject (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
n)
(TextObject -> CountedTextObject)
-> TextObject -> CountedTextObject
forall a b. (a -> b) -> a -> b
$ (RegionStyle -> RegionStyle) -> TextObject -> TextObject
changeTextObjectStyle RegionStyle -> RegionStyle
sm TextObject
to
MatchResult TextObject
_ -> OperandParseResult
NoOperand
splitCountModifierCommand :: String -> (Maybe Int, String, String)
splitCountModifierCommand :: String -> (Maybe Int, String, String)
splitCountModifierCommand = String
-> Maybe Int -> [String] -> String -> (Maybe Int, String, String)
forall a.
(Num a, Read a) =>
String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go String
"" Maybe Int
forall a. Maybe a
Nothing [String
""]
where go :: String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go String
"" Maybe a
Nothing [String]
mods String
"0" = (Maybe a
forall a. Maybe a
Nothing, [String] -> String
forall a. [a] -> a
head [String]
mods, String
"0")
go String
ds Maybe a
count [String]
mods (Char
h:String
t) | Char -> Bool
isDigit Char
h = String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go (String
ds String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
h]) Maybe a
count [String]
mods String
t
go ds :: String
ds@(Char
_:String
_) Maybe a
count [String]
mods s :: String
s@(Char
h:String
_) | Bool -> Bool
not (Char -> Bool
isDigit Char
h) = String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go [] (Maybe a -> Maybe a -> Maybe a
forall a. Num a => Maybe a -> Maybe a -> Maybe a
maybeMult Maybe a
count (a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
ds))) [String]
mods String
s
go [] Maybe a
count [String]
mods (Char
h:String
t) | Char
h Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'v', Char
'V'] = String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go [] Maybe a
count ([Char
h]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
mods) String
t
go [] Maybe a
count [String]
mods String
s | String
"<C-v>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go [] Maybe a
count (String
"<C-v>"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
mods) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 String
s)
go [] Maybe a
count [String]
mods String
s = (Maybe a
count, [String] -> String
forall a. [a] -> a
head [String]
mods, String
s)
go String
ds Maybe a
count [String]
mods [] = (Maybe a -> Maybe a -> Maybe a
forall a. Num a => Maybe a -> Maybe a -> Maybe a
maybeMult Maybe a
count (a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
ds)), [String] -> String
forall a. [a] -> a
head [String]
mods, [])
go (Char
_:String
_) Maybe a
_ [String]
_ (Char
_:String
_) = String -> (Maybe a, String, String)
forall a. HasCallStack => String -> a
error String
"Can't happen because isDigit and not isDigit cover every case"