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

-- |
-- Module      :  Yi.Keymap.Vim.Operator
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Implements some operators for the Vim keymap.

module Yi.Keymap.Vim.Operator
    ( VimOperator(..)
    , defOperators
    , opDelete
    , opChange
    , opYank
    , opFormat
    , stringToOperator
    , mkCharTransformOperator
    , operatorApplyToTextObjectE
    , lastCharForOperator
    ) where

import           Control.Monad              (when)
import           Data.Char                  (isSpace, toLower, toUpper)
import           Data.Foldable              (find)
import qualified Data.List.NonEmpty as NE
import           Data.Maybe                 (fromJust)
import           Data.Monoid                ((<>))
import qualified Data.Text                  as T (unpack)
import           Yi.Buffer                  hiding (Insert)
import           Yi.Buffer.Misc             (startUpdateTransactionB)
import           Yi.Editor                  (EditorM, getEditorDyn, withCurrentBuffer)
import           Yi.Keymap.Vim.Common
import           Yi.Keymap.Vim.EventUtils   (eventToEventString, parseEvents)
import           Yi.Keymap.Vim.StateUtils   (setRegisterE, switchModeE, modifyStateE)
import           Yi.Keymap.Vim.StyledRegion (StyledRegion (..), transformCharactersInRegionB)
import           Yi.Keymap.Vim.TextObject   (CountedTextObject, regionOfTextObjectB)
import           Yi.Keymap.Vim.Utils        (indentBlockRegionB)
import           Yi.Misc                    (rot13Char)
import           Yi.Rope                    (YiString)
import qualified Yi.Rope                    as R

data VimOperator = VimOperator {
    VimOperator -> OperatorName
operatorName :: !OperatorName
  , VimOperator -> Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
}

defOperators :: [VimOperator]
defOperators :: [VimOperator]
defOperators =
    [ VimOperator
opYank
    , VimOperator
opDelete
    , VimOperator
opChange
    , VimOperator
opFormat
    , OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator OperatorName
"gu" Char -> Char
toLower
    , OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator OperatorName
"gU" Char -> Char
toUpper
    , OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator OperatorName
"g~" Char -> Char
switchCaseChar
    , OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator OperatorName
"g?" Char -> Char
rot13Char
    , OperatorName -> (Int -> Int) -> VimOperator
mkShiftOperator OperatorName
">" Int -> Int
forall a. a -> a
id
    , OperatorName -> (Int -> Int) -> VimOperator
mkShiftOperator OperatorName
"<lt>" Int -> Int
forall a. Num a => a -> a
negate
    ]

stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator
stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator
stringToOperator [VimOperator]
ops OperatorName
name = (VimOperator -> Bool) -> [VimOperator] -> Maybe VimOperator
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((OperatorName -> OperatorName -> Bool
forall a. Eq a => a -> a -> Bool
== OperatorName
name) (OperatorName -> Bool)
-> (VimOperator -> OperatorName) -> VimOperator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimOperator -> OperatorName
operatorName) [VimOperator]
ops

operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken
operatorApplyToTextObjectE VimOperator
op Int
count CountedTextObject
cto = do
    styledRegion <- 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
$ CountedTextObject -> BufferM StyledRegion
regionOfTextObjectB CountedTextObject
cto
    operatorApplyToRegionE op count styledRegion

opYank :: VimOperator
opYank :: VimOperator
opYank = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
"y"
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
_count (StyledRegion RegionStyle
style Region
reg) -> do
        s <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB Region
reg RegionStyle
style
        regName <- fmap vsActiveRegister getEditorDyn
        setRegisterE regName style s
        withCurrentBuffer $ moveTo . regionStart =<< convertRegionToStyleB reg style
        switchModeE Normal
        return Finish
}

opDelete :: VimOperator
opDelete :: VimOperator
opDelete = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
"d"
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
_count (StyledRegion RegionStyle
style Region
reg) -> do
        s <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB Region
reg RegionStyle
style
        regName <- fmap vsActiveRegister getEditorDyn
        setRegisterE regName style s
        withCurrentBuffer $ do
            point <- NE.head <$> deleteRegionWithStyleB reg style
            moveTo point
            eof <- atEof
            if eof
            then do
                leftB
                c <- readB
                when (c == '\n') $ deleteN 1 >> moveToSol
            else leftOnEol
        switchModeE Normal
        return Finish
}

opChange :: VimOperator
opChange :: VimOperator
opChange = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
"c"
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
_count (StyledRegion RegionStyle
style Region
reg) -> do
        s <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ Region -> RegionStyle -> BufferM YiString
readRegionRopeWithStyleB Region
reg RegionStyle
style
        regName <- fmap vsActiveRegister getEditorDyn
        setRegisterE regName style s
        do
            withCurrentBuffer $ startUpdateTransactionB
            case style of
                RegionStyle
LineWise -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
                    point <- NonEmpty Point -> Point
forall a. NonEmpty a -> a
NE.head (NonEmpty Point -> Point)
-> BufferM (NonEmpty Point) -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB Region
reg RegionStyle
style
                    moveTo point
                    insertB '\n'
                    leftB
                RegionStyle
Block -> do
                    points <- BufferM (NonEmpty Point) -> EditorM (NonEmpty Point)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (NonEmpty Point) -> EditorM (NonEmpty Point))
-> BufferM (NonEmpty Point) -> EditorM (NonEmpty Point)
forall a b. (a -> b) -> a -> b
$ do
                        points <- Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB Region
reg RegionStyle
style
                        moveTo $ NE.head points
                        return points
                    modifyStateE $ \VimState
s -> VimState
s { vsSecondaryCursors = NE.tail points }
                RegionStyle
_ -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ do
                    point <- NonEmpty Point -> Point
forall a. NonEmpty a -> a
NE.head (NonEmpty Point -> Point)
-> BufferM (NonEmpty Point) -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> RegionStyle -> BufferM (NonEmpty Point)
deleteRegionWithStyleB Region
reg RegionStyle
style
                    moveTo point
        switchModeE $ Insert 'c'
        return Continue
}

opFormat :: VimOperator
opFormat :: VimOperator
opFormat = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
"gq"
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
_count (StyledRegion RegionStyle
style Region
reg) -> do
      BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ RegionStyle -> Region -> BufferM ()
formatRegionB RegionStyle
style Region
reg
      VimMode -> EditorM ()
switchModeE VimMode
Normal
      RepeatToken -> EditorM RepeatToken
forall a. a -> EditorM a
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Finish
}

formatRegionB :: RegionStyle -> Region -> BufferM ()
formatRegionB :: RegionStyle -> Region -> BufferM ()
formatRegionB RegionStyle
Block Region
_reg = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
formatRegionB RegionStyle
_style Region
reg = do
    start <- Point -> BufferM Point
solPointB (Point -> BufferM Point) -> Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
reg
    end <- eolPointB $ regionEnd reg
    moveTo start
    -- Don't use firstNonSpaceB since paragraphs can start with lines made
    -- completely of whitespace (which should be fixed)
    untilB_ ((not . isSpace) <$> readB) rightB
    indent <- curCol
    modifyRegionB (formatStringWithIndent indent) $ reg { regionStart = start
                                                        , regionEnd = end
                                                        }
    -- Emulate vim behaviour
    moveTo =<< solPointB end
    firstNonSpaceB

formatStringWithIndent :: Int -> YiString -> YiString
formatStringWithIndent :: Int -> YiString -> YiString
formatStringWithIndent Int
indent YiString
str
    | YiString -> Bool
R.null YiString
str = YiString
R.empty
    | Bool
otherwise = let spaces :: YiString
spaces = Int -> Char -> YiString
R.replicateChar Int
indent Char
' '
                      (YiString
formattedLine, YiString
textToFormat) = Int -> YiString -> (YiString, YiString)
getNextLine (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indent) YiString
str
                      lineEnd :: YiString
lineEnd = if YiString -> Bool
R.null YiString
textToFormat
                                then YiString
R.empty
                                else Char
'\n' Char -> YiString -> YiString
`R.cons` Int -> YiString -> YiString
formatStringWithIndent Int
indent YiString
textToFormat
                  in [YiString] -> YiString
R.concat [ YiString
spaces
                              , YiString
formattedLine
                              , YiString
lineEnd
                              ]

getNextLine :: Int -> YiString -> (YiString, YiString)
getNextLine :: Int -> YiString -> (YiString, YiString)
getNextLine Int
maxLength YiString
str = let firstSplit :: (YiString, YiString)
firstSplit = (YiString, YiString) -> (YiString, YiString)
takeBlock (YiString
R.empty, (Char -> Bool) -> YiString -> YiString
R.dropWhile Char -> Bool
isSpace YiString
str)
                                isMaxLength :: (YiString, YiString) -> Bool
isMaxLength (YiString
l, YiString
r) = YiString -> Int
R.length YiString
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLength Bool -> Bool -> Bool
|| YiString -> Bool
R.null YiString
r
                            in if (YiString, YiString) -> Bool
isMaxLength (YiString, YiString)
firstSplit
                               then (YiString, YiString)
firstSplit
                               else let (YiString
line, YiString
remainingText) = ((YiString, YiString) -> Bool)
-> ((YiString, YiString) -> (YiString, YiString))
-> (YiString, YiString)
-> (YiString, YiString)
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (YiString, YiString) -> Bool
isMaxLength
                                                                      (YiString, YiString) -> (YiString, YiString)
takeBlock
                                                                      (YiString, YiString)
firstSplit
                                    in if YiString -> Int
R.length YiString
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLength
                                       then ((Char -> Bool) -> YiString -> YiString
R.dropWhileEnd Char -> Bool
isSpace YiString
line, YiString
remainingText)
                                       else let (YiString
beginL, YiString
endL) = YiString -> (YiString, YiString)
breakAtLastItem YiString
line
                                            in if Char -> Bool
isSpace (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$ YiString -> Maybe Char
R.head YiString
endL
                                               then (YiString
beginL, YiString
remainingText)
                                               else ((Char -> Bool) -> YiString -> YiString
R.dropWhileEnd Char -> Bool
isSpace YiString
beginL, YiString
endL YiString -> YiString -> YiString
`R.append` YiString
remainingText)
                            where
                                isMatch :: Maybe Char -> Char -> Bool
isMatch (Just Char
x) Char
y = Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isSpace Char
y
                                isMatch Maybe Char
Nothing Char
_ = Bool
False

                                -- Gets the next block of either whitespace, or non-whitespace,
                                -- characters
                                takeBlock :: (YiString, YiString) -> (YiString, YiString)
takeBlock (YiString
cur, YiString
rest) =
                                    let (YiString
word, YiString
line) = (Char -> Bool) -> YiString -> (YiString, YiString)
R.span (Maybe Char -> Char -> Bool
isMatch (Maybe Char -> Char -> Bool) -> Maybe Char -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ YiString -> Maybe Char
R.head YiString
rest) YiString
rest
                                    in (YiString
cur YiString -> YiString -> YiString
`R.append` (Char -> Char) -> YiString -> YiString
R.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Char
' ' else Char
c) YiString
word, YiString
line)
                                breakAtLastItem :: YiString -> (YiString, YiString)
breakAtLastItem YiString
s =
                                    let y :: YiString
y = (Char -> Bool) -> YiString -> YiString
R.takeWhileEnd (Maybe Char -> Char -> Bool
isMatch (Maybe Char -> Char -> Bool) -> Maybe Char -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ YiString -> Maybe Char
R.last YiString
s) YiString
s
                                        (YiString
x, YiString
_) = Int -> YiString -> (YiString, YiString)
R.splitAt (YiString -> Int
R.length YiString
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- YiString -> Int
R.length YiString
y) YiString
s
                                    in (YiString
x, YiString
y)

mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator
mkCharTransformOperator OperatorName
name Char -> Char
f = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
name
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
count StyledRegion
sreg -> do
        BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$ StyledRegion -> (Char -> Char) -> BufferM ()
transformCharactersInRegionB StyledRegion
sreg
                    ((Char -> Char) -> BufferM ()) -> (Char -> Char) -> BufferM ()
forall a b. (a -> b) -> a -> b
$ ((Char -> Char) -> (Char -> Char) -> Char -> Char)
-> (Char -> Char) -> [Char -> Char] -> Char -> Char
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Char -> Char) -> (Char -> Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Char -> Char
forall a. a -> a
id (Int -> (Char -> Char) -> [Char -> Char]
forall a. Int -> a -> [a]
replicate Int
count Char -> Char
f)
        VimMode -> EditorM ()
switchModeE VimMode
Normal
        RepeatToken -> EditorM RepeatToken
forall a. a -> EditorM a
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Finish
}

mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator
mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator
mkShiftOperator OperatorName
name Int -> Int
countMod = VimOperator {
    operatorName :: OperatorName
operatorName = OperatorName
name
  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken
operatorApplyToRegionE = \Int
count (StyledRegion RegionStyle
style Region
reg) -> do
        BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
            if RegionStyle
style RegionStyle -> RegionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== RegionStyle
Block
            then Int -> Region -> BufferM ()
indentBlockRegionB (Int -> Int
countMod Int
count) Region
reg
            else do
                reg' <- Region -> RegionStyle -> BufferM Region
convertRegionToStyleB Region
reg RegionStyle
style
                shiftIndentOfRegionB (countMod count) reg'
        VimMode -> EditorM ()
switchModeE VimMode
Normal
        RepeatToken -> EditorM RepeatToken
forall a. a -> EditorM a
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Finish
}

lastCharForOperator :: VimOperator -> String
lastCharForOperator :: VimOperator -> [Char]
lastCharForOperator (VimOperator { operatorName :: VimOperator -> OperatorName
operatorName = OperatorName
name })
    -- This cast here seems stupid, maybe we should only have one
    -- type?
    = case EventString -> [Event]
parseEvents (Text -> EventString
Ev (Text -> EventString)
-> (OperatorName -> Text) -> OperatorName -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperatorName -> Text
_unOp (OperatorName -> EventString) -> OperatorName -> EventString
forall a b. (a -> b) -> a -> b
$ OperatorName
name) of
        [] -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid operator name " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (OperatorName -> Text
_unOp OperatorName
name)
        [Event]
evs -> Text -> [Char]
T.unpack (Text -> [Char]) -> (Event -> Text) -> Event -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> Text) -> (Event -> EventString) -> Event -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> EventString
eventToEventString (Event -> [Char]) -> Event -> [Char]
forall a b. (a -> b) -> a -> b
$ [Event] -> Event
forall a. HasCallStack => [a] -> a
last [Event]
evs