{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim.Utils
( mkBindingE
, mkBindingY
, mkStringBindingE
, mkStringBindingY
, splitCountedCommand
, selectBinding
, selectPureBinding
, matchFromBool
, mkMotionBinding
, mkChooseRegisterBinding
, pasteInclusiveB
, addNewLineIfNecessary
, indentBlockRegionB
, addVimJumpHereE
, exportRegisterToClipboard
, pasteFromClipboard
) where
import Lens.Micro.Platform ((.=), use)
import Control.Monad (forM_, void, when)
import Data.Char (isSpace)
import Data.Foldable (asum)
import Data.List (group)
import qualified Data.Text as T (unpack)
import Safe (headDef)
import Yi.Buffer hiding (Insert)
import Yi.Editor
import Yi.Event (Event)
import Yi.Keymap (YiM)
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.EventUtils (eventToEventString, splitCountedCommand)
import Yi.Keymap.Vim.MatchResult
import Yi.Keymap.Vim.Motion (Move (Move), stringToMove)
import Yi.Keymap.Vim.StateUtils (getMaybeCountE, modifyStateE,
resetCountE, getRegisterE)
import Yi.Monad (whenM)
import Yi.Rope (YiString, countNewLines, last)
import qualified Yi.Rope as R (replicateChar, snoc, toString, fromString)
import Yi.Utils (io)
import System.Hclip (getClipboard, setClipboard)
mkStringBindingE :: VimMode -> RepeatToken
-> (EventString, EditorM (), VimState -> VimState) -> VimBinding
mkStringBindingE :: VimMode
-> RepeatToken
-> (EventString, EditorM (), VimState -> VimState)
-> VimBinding
mkStringBindingE VimMode
mode RepeatToken
rtoken (EventString
eventString, EditorM ()
action, VimState -> VimState
mutate) = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
_ VimState
vs | VimState -> VimMode
vsMode VimState
vs VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
/= VimMode
mode = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
f EventString
evs VimState
_ = EditorM ()
-> (VimState -> VimState) -> RepeatToken -> EditorM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction EditorM ()
action VimState -> VimState
mutate RepeatToken
rtoken EditorM RepeatToken
-> MatchResult () -> MatchResult (EditorM RepeatToken)
forall a b. a -> MatchResult b -> MatchResult a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
EventString
evs EventString -> EventString -> MatchResult ()
`matchesString` EventString
eventString
mkStringBindingY :: VimMode
-> (EventString, YiM (), VimState -> VimState) -> VimBinding
mkStringBindingY :: VimMode
-> (EventString, YiM (), VimState -> VimState) -> VimBinding
mkStringBindingY VimMode
mode (EventString
eventString, YiM ()
action, VimState -> VimState
mutate) = (EventString -> VimState -> MatchResult (YiM RepeatToken))
-> VimBinding
VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
f
where f :: EventString -> VimState -> MatchResult (YiM RepeatToken)
f EventString
_ VimState
vs | VimState -> VimMode
vsMode VimState
vs VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
/= VimMode
mode = MatchResult (YiM RepeatToken)
forall a. MatchResult a
NoMatch
f EventString
evs VimState
_ = YiM () -> (VimState -> VimState) -> RepeatToken -> YiM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction YiM ()
action VimState -> VimState
mutate RepeatToken
Drop YiM RepeatToken -> MatchResult () -> MatchResult (YiM RepeatToken)
forall a b. a -> MatchResult b -> MatchResult a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
EventString
evs EventString -> EventString -> MatchResult ()
`matchesString` EventString
eventString
mkBindingE :: VimMode -> RepeatToken -> (Event, EditorM (), VimState -> VimState) -> VimBinding
mkBindingE :: VimMode
-> RepeatToken
-> (Event, EditorM (), VimState -> VimState)
-> VimBinding
mkBindingE VimMode
mode RepeatToken
rtoken (Event
event, EditorM ()
action, VimState -> VimState
mutate) = (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 = EditorM ()
-> (VimState -> VimState) -> RepeatToken -> EditorM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction EditorM ()
action VimState -> VimState
mutate RepeatToken
rtoken EditorM RepeatToken
-> MatchResult () -> MatchResult (EditorM RepeatToken)
forall a b. a -> MatchResult b -> MatchResult a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
Bool -> MatchResult ()
matchFromBool (VimState -> VimMode
vsMode VimState
vs VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
== VimMode
mode Bool -> Bool -> Bool
&& EventString
evs EventString -> EventString -> Bool
forall a. Eq a => a -> a -> Bool
== Event -> EventString
eventToEventString Event
event)
mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding
mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding
mkBindingY VimMode
mode (Event
event, YiM ()
action, VimState -> VimState
mutate) = (EventString -> VimState -> MatchResult (YiM RepeatToken))
-> VimBinding
VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
f
where f :: EventString -> VimState -> MatchResult (YiM RepeatToken)
f EventString
evs VimState
vs = YiM () -> (VimState -> VimState) -> RepeatToken -> YiM RepeatToken
forall (m :: * -> *).
MonadEditor m =>
m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction YiM ()
action VimState -> VimState
mutate RepeatToken
Drop YiM RepeatToken -> MatchResult () -> MatchResult (YiM RepeatToken)
forall a b. a -> MatchResult b -> MatchResult a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
Bool -> MatchResult ()
matchFromBool (VimState -> VimMode
vsMode VimState
vs VimMode -> VimMode -> Bool
forall a. Eq a => a -> a -> Bool
== VimMode
mode Bool -> Bool -> Bool
&& EventString
evs EventString -> EventString -> Bool
forall a. Eq a => a -> a -> Bool
== Event -> EventString
eventToEventString Event
event)
combineAction :: MonadEditor m => m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction :: forall (m :: * -> *).
MonadEditor m =>
m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken
combineAction m ()
action VimState -> VimState
mutateState RepeatToken
rtoken = do
m ()
action
EditorM () -> m ()
forall a. EditorM a -> m a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> m ()) -> EditorM () -> m ()
forall a b. (a -> b) -> a -> b
$ (VimState -> VimState) -> EditorM ()
modifyStateE VimState -> VimState
mutateState
RepeatToken -> m RepeatToken
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
rtoken
selectPureBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken)
selectPureBinding :: EventString
-> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken)
selectPureBinding EventString
evs VimState
state = [MatchResult (EditorM RepeatToken)]
-> MatchResult (EditorM RepeatToken)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([MatchResult (EditorM RepeatToken)]
-> MatchResult (EditorM RepeatToken))
-> ([VimBinding] -> [MatchResult (EditorM RepeatToken)])
-> [VimBinding]
-> MatchResult (EditorM RepeatToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VimBinding -> MatchResult (EditorM RepeatToken))
-> [VimBinding] -> [MatchResult (EditorM RepeatToken)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VimBinding -> MatchResult (EditorM RepeatToken)
try
where try :: VimBinding -> MatchResult (EditorM RepeatToken)
try (VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
matcher) = EventString -> VimState -> MatchResult (EditorM RepeatToken)
matcher EventString
evs VimState
state
try (VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
_) = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
selectBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)
selectBinding :: EventString
-> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)
selectBinding EventString
input VimState
state = [MatchResult (YiM RepeatToken)] -> MatchResult (YiM RepeatToken)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([MatchResult (YiM RepeatToken)] -> MatchResult (YiM RepeatToken))
-> ([VimBinding] -> [MatchResult (YiM RepeatToken)])
-> [VimBinding]
-> MatchResult (YiM RepeatToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VimBinding -> MatchResult (YiM RepeatToken))
-> [VimBinding] -> [MatchResult (YiM RepeatToken)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VimBinding -> MatchResult (YiM RepeatToken)
try
where try :: VimBinding -> MatchResult (YiM RepeatToken)
try (VimBindingY EventString -> VimState -> MatchResult (YiM RepeatToken)
matcher) = EventString -> VimState -> MatchResult (YiM RepeatToken)
matcher EventString
input VimState
state
try (VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
matcher) = (EditorM RepeatToken -> YiM RepeatToken)
-> MatchResult (EditorM RepeatToken)
-> MatchResult (YiM RepeatToken)
forall a b. (a -> b) -> MatchResult a -> MatchResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EditorM RepeatToken -> YiM RepeatToken
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (MatchResult (EditorM RepeatToken)
-> MatchResult (YiM RepeatToken))
-> MatchResult (EditorM RepeatToken)
-> MatchResult (YiM RepeatToken)
forall a b. (a -> b) -> a -> b
$ EventString -> VimState -> MatchResult (EditorM RepeatToken)
matcher EventString
input VimState
state
setUnjumpMarks :: Point -> BufferM ()
setUnjumpMarks :: Point -> BufferM ()
setUnjumpMarks Point
p = do
solP <- Point -> BufferM Point
solPointB Point
p
lineStream <- indexedStreamB Forward solP
let fstNonBlank =
Point -> [Point] -> Point
forall a. a -> [a] -> a
headDef Point
solP [ Point
p' | (Point
p', Char
ch) <- [(Point, Char)]
lineStream, Bool -> Bool
not (Char -> Bool
isSpace Char
ch) Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' ]
(.= p) . markPointA =<< getMarkB (Just "`")
(.= fstNonBlank) . markPointA =<< getMarkB (Just "'")
addVimJumpAtE :: Point -> EditorM ()
addVimJumpAtE :: Point -> EditorM ()
addVimJumpAtE Point
p = do
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 ()
setUnjumpMarks Point
p
Point -> EditorM ()
addJumpAtE Point
p
addVimJumpHereE :: EditorM ()
addVimJumpHereE :: EditorM ()
addVimJumpHereE = do
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 ()
setUnjumpMarks (Point -> BufferM ()) -> BufferM Point -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Point
pointB
EditorM ()
addJumpHereE
mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding
mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding
mkMotionBinding RepeatToken
token VimMode -> Bool
condition = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
f
where
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)
f EventString
evs VimState
state | VimMode -> Bool
condition (VimState -> VimMode
vsMode VimState
state) =
(Move -> EditorM RepeatToken)
-> MatchResult Move -> MatchResult (EditorM RepeatToken)
forall a b. (a -> b) -> MatchResult a -> MatchResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Move -> EditorM RepeatToken
go (String -> Move -> EditorM RepeatToken)
-> (EventString -> String)
-> EventString
-> Move
-> EditorM RepeatToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv (EventString -> Move -> EditorM RepeatToken)
-> EventString -> Move -> EditorM RepeatToken
forall a b. (a -> b) -> a -> b
$ EventString
evs) (EventString -> MatchResult Move
stringToMove EventString
evs)
f EventString
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
go :: String -> Move -> EditorM RepeatToken
go :: String -> Move -> EditorM RepeatToken
go String
evs (Move RegionStyle
_style Bool
isJump Maybe Int -> BufferM ()
move) = do
count <- EditorM (Maybe Int)
getMaybeCountE
prevPoint <- withCurrentBuffer $ do
p <- pointB
move count
leftOnEol
return p
when isJump $ addVimJumpAtE prevPoint
resetCountE
sticky <- withCurrentBuffer $ use stickyEolA
when (evs == "$") . withCurrentBuffer $ stickyEolA .= True
when (evs `elem` group "jk" && sticky) $
withCurrentBuffer $ moveToEol >> moveXorSol 1
when (evs `notElem` group "jk$") . withCurrentBuffer $ stickyEolA .= False
let m = String -> Char
forall a. HasCallStack => [a] -> a
head String
evs
when (m `elem` ('f' : "FtT")) $ do
let c = String -> Char
forall a. HasCallStack => [a] -> a
Prelude.last String
evs
(dir, style) =
case m of
Char
'f' -> (Direction
Forward, RegionStyle
Inclusive)
Char
't' -> (Direction
Forward, RegionStyle
Exclusive)
Char
'F' -> (Direction
Backward, RegionStyle
Inclusive)
Char
'T' -> (Direction
Backward, RegionStyle
Exclusive)
Char
_ -> String -> (Direction, RegionStyle)
forall a. HasCallStack => String -> a
error String
"can't happen"
command = Char -> Direction -> RegionStyle -> GotoCharCommand
GotoCharCommand Char
c Direction
dir RegionStyle
style
modifyStateE $ \VimState
s -> VimState
s { vsLastGotoCharCommand = Just command}
return token
mkChooseRegisterBinding :: (VimState -> Bool) -> VimBinding
mkChooseRegisterBinding :: (VimState -> Bool) -> VimBinding
mkChooseRegisterBinding VimState -> Bool
statePredicate = (EventString -> VimState -> MatchResult (EditorM RepeatToken))
-> VimBinding
VimBindingE (String -> VimState -> MatchResult (EditorM RepeatToken)
f (String -> VimState -> MatchResult (EditorM RepeatToken))
-> (EventString -> String)
-> EventString
-> VimState
-> MatchResult (EditorM RepeatToken)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (EventString -> Text) -> EventString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> Text
_unEv)
where f :: String -> VimState -> MatchResult (EditorM RepeatToken)
f String
"\"" VimState
s | VimState -> Bool
statePredicate VimState
s = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
PartialMatch
f [Char
'"', Char
c] VimState
s | VimState -> Bool
statePredicate VimState
s = 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
$ do
(VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
s' -> VimState
s' { vsActiveRegister = c }
RepeatToken -> EditorM RepeatToken
forall a. a -> EditorM a
forall (m :: * -> *) a. Monad m => a -> m a
return RepeatToken
Continue
f String
_ VimState
_ = MatchResult (EditorM RepeatToken)
forall a. MatchResult a
NoMatch
indentBlockRegionB :: Int -> Region -> BufferM ()
indentBlockRegionB :: Int -> Region -> BufferM ()
indentBlockRegionB Int
count Region
reg = do
indentSettings <- BufferM IndentSettings
indentSettingsB
(start, lengths) <- shapeOfBlockRegionB reg
moveTo start
forM_ (zip [1..] lengths) $ \(Int
i, Int
_) -> do
BufferM Bool -> BufferM () -> BufferM ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> BufferM Bool -> BufferM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Bool
atEol) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ do
let w :: Int
w = IndentSettings -> Int
shiftWidth IndentSettings
indentSettings
if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> YiString
R.replicateChar (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) Char
' '
else Int -> BufferM ()
forall {t}. (Eq t, Num t) => t -> BufferM ()
go (Int -> Int
forall a. Num a => a -> a
abs Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)
Point -> BufferM ()
moveTo Point
start
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
i
moveTo start
where
go :: t -> BufferM ()
go t
0 = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go t
n = do
c <- BufferM Char
readB
when (c == ' ') $
deleteN 1 >> go (n - 1)
pasteInclusiveB :: YiString -> RegionStyle -> BufferM ()
pasteInclusiveB :: YiString -> RegionStyle -> BufferM ()
pasteInclusiveB YiString
rope RegionStyle
style = do
p0 <- BufferM Point
pointB
insertRopeWithStyleB rope style
if countNewLines rope == 0 && style `elem` [ Exclusive, Inclusive ]
then leftB
else moveTo p0
trailingNewline :: YiString -> Bool
trailingNewline :: YiString -> Bool
trailingNewline YiString
t = case YiString -> Maybe Char
Yi.Rope.last YiString
t of
Just Char
'\n' -> Bool
True
Maybe Char
_ -> Bool
False
addNewLineIfNecessary :: YiString -> YiString
addNewLineIfNecessary :: YiString -> YiString
addNewLineIfNecessary YiString
rope =
if YiString -> Bool
trailingNewline YiString
rope then YiString
rope else YiString
rope YiString -> Char -> YiString
`R.snoc` Char
'\n'
pasteFromClipboard :: YiM ()
pasteFromClipboard :: YiM ()
pasteFromClipboard = do
text <- (String -> YiString) -> YiM String -> YiM YiString
forall a b. (a -> b) -> YiM a -> YiM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> YiString
R.fromString (YiM String -> YiM YiString) -> YiM String -> YiM YiString
forall a b. (a -> b) -> a -> b
$ IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
getClipboard
withCurrentBuffer $ insertRopeWithStyleB text Inclusive
exportRegisterToClipboard :: RegisterName -> YiM ()
exportRegisterToClipboard :: Char -> YiM ()
exportRegisterToClipboard Char
name = do
mbr <- EditorM (Maybe Register) -> YiM (Maybe Register)
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (Maybe Register) -> YiM (Maybe Register))
-> EditorM (Maybe Register) -> YiM (Maybe Register)
forall a b. (a -> b) -> a -> b
$ Char -> EditorM (Maybe Register)
getRegisterE Char
name
io . setClipboard $ maybe "" (R.toString . regContent) mbr