{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.NormalOperatorPendingMap
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

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

        -- vim treats cw as ce
        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
            -- TODO: fix parseOperand to take EventString as second arg
            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 -- ^ like dd and d2vd
    | 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"

-- | TODO: should this String be EventString?
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

-- TODO: setup doctests
-- Parse event string that can go after operator
-- w -> (Nothing, "", "w")
-- 2w -> (Just 2, "", "w")
-- V2w -> (Just 2, "V", "w")
-- v2V3<C-v>w -> (Just 6, "<C-v>", "w")
-- vvvvvvvvvvvvvw -> (Nothing, "v", "w")
-- 0 -> (Nothing, "", "0")
-- V0 -> (Nothing, "V", "0")
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"