{-# 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 operators :: [VimOperator]
operators = [[VimOperator] -> VimBinding
textObject [VimOperator]
operators, VimBinding
escBinding]
textObject :: [VimOperator] -> VimBinding
textObject :: [VimOperator] -> VimBinding
textObject operators :: [VimOperator]
operators = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
where
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f evs :: EventString
evs vs :: VimState
vs = case VimState -> VimMode
vsMode VimState
vs of
NormalOperatorPending _ -> 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
_ -> MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
action :: EventString -> EditorM RepeatToken
action (Ev evs :: 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 opname :: 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 "c" Bool -> Bool -> Bool
&& Text -> Char
T.last Text
evs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'w' Bool -> Bool -> Bool
&&
(case EventString -> String -> OperandParseResult
parseOperand EventString
opChar (Text -> String
evr Text
evs) of
JustMove _ -> Bool
True
_ -> Bool
False)
then Text -> Text
T.init Text
evs Text -> Char -> Text
`T.snoc` 'e'
else Text
evs
evr :: Text -> String
evr x :: 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
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
PartialOperand -> do
EventString -> EditorM ()
accumulateTextObjectEventE (Text -> EventString
Ev Text
evs)
RepeatToken -> EditorM RepeatToken
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Continue
_ -> do
Int
count <- EditorM Int
getCountE
EditorM ()
dropTextObjectAccumulatorE
RepeatToken
token <- case OperandParseResult
operand of
JustTextObject cto :: CountedTextObject
cto@(CountedTextObject n :: Int
n _) -> do
Maybe Int -> EditorM ()
normalizeCountE (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
operatorApplyToTextObjectE VimOperator
op 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 n :: Maybe Int
n m :: 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 1 StyledRegion
region
JustOperator n :: Int
n style :: 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 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 "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
_ -> String -> EditorM RepeatToken
forall a. HasCallStack => String -> a
error "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 n :: Int
n style :: 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
== 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
-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 opChar :: EventString
opChar s :: String
s = Maybe Int
-> (RegionStyle -> RegionStyle)
-> EventString
-> String
-> OperandParseResult
parseCommand Maybe Int
mcount RegionStyle -> RegionStyle
styleMod EventString
opChar String
commandString
where (mcount :: Maybe Int
mcount, styleModString :: String
styleModString, commandString :: String
commandString) = String -> (Maybe Int, String, String)
splitCountModifierCommand String
s
styleMod :: RegionStyle -> RegionStyle
styleMod = case String
styleModString of
"" -> RegionStyle -> RegionStyle
forall a. a -> a
id
"V" -> RegionStyle -> RegionStyle -> RegionStyle
forall a b. a -> b -> a
const RegionStyle
LineWise
"<C-v>" -> RegionStyle -> RegionStyle -> RegionStyle
forall a b. a -> b -> a
const RegionStyle
Block
"v" -> \style :: RegionStyle
style -> case RegionStyle
style of
Exclusive -> RegionStyle
Inclusive
_ -> RegionStyle
Exclusive
_ -> String -> RegionStyle -> RegionStyle
forall a. HasCallStack => String -> a
error "Can't happen"
parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)
-> EventString -> String -> OperandParseResult
parseCommand :: Maybe Int
-> (RegionStyle -> RegionStyle)
-> EventString
-> String
-> OperandParseResult
parseCommand _ _ _ "" = OperandParseResult
PartialOperand
parseCommand _ _ _ "i" = OperandParseResult
PartialOperand
parseCommand _ _ _ "a" = OperandParseResult
PartialOperand
parseCommand _ _ _ "g" = OperandParseResult
PartialOperand
parseCommand n :: Maybe Int
n sm :: RegionStyle -> RegionStyle
sm o :: EventString
o s :: 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 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 n :: Maybe Int
n sm :: RegionStyle -> RegionStyle
sm _ "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 n :: Maybe Int
n sm :: RegionStyle -> RegionStyle
sm _ s :: 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 m :: 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
PartialMatch -> OperandParseResult
PartialOperand
NoMatch -> case String -> MatchResult TextObject
stringToTextObject String
s of
WholeMatch to :: 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 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
_ -> 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 "" Maybe Int
forall a. Maybe a
Nothing [""]
where go :: String
-> Maybe a -> [String] -> String -> (Maybe a, String, String)
go "" Nothing mods :: [String]
mods "0" = (Maybe a
forall a. Maybe a
Nothing, [String] -> String
forall a. [a] -> a
head [String]
mods, "0")
go ds :: String
ds count :: Maybe a
count mods :: [String]
mods (h :: Char
h:t :: 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@(_:_) count :: Maybe a
count mods :: [String]
mods s :: String
s@(h :: Char
h:_) | 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 [] count :: Maybe a
count mods :: [String]
mods (h :: Char
h:t :: String
t) | Char
h Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['v', '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 [] count :: Maybe a
count mods :: [String]
mods s :: String
s | "<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 ("<C-v>"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
mods) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 5 String
s)
go [] count :: Maybe a
count mods :: [String]
mods s :: String
s = (Maybe a
count, [String] -> String
forall a. [a] -> a
head [String]
mods, String
s)
go ds :: String
ds count :: Maybe a
count mods :: [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 (_:_) _ _ (_:_) = String -> (Maybe a, String, String)
forall a. HasCallStack => String -> a
error "Can't happen because isDigit and not isDigit cover every case"