{-# 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 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

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

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

-- 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 "" 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"