{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Vim
( keymapSet
, mkKeymapSet
, defVimConfig
, VimBinding (..)
, VimOperator (..)
, VimConfig (..)
, pureEval
, impureEval
, relayoutFromTo
) where
import Data.Char (toUpper)
import Data.List (find)
import Data.Monoid ((<>))
import Data.Prototype (Proto (Proto), extractValue)
import Yi.Buffer (commitUpdateTransactionB, startUpdateTransactionB)
import Yi.Editor
import Yi.Event (Event (..), Key (KASCII), Modifier (MCtrl, MMeta))
import Yi.Keymap (Keymap, KeymapM, KeymapSet, YiM, modelessKeymapSet, write)
import Yi.Keymap.Keys (anyEvent)
import Yi.Keymap.Vim.Common
import Yi.Keymap.Vim.Digraph (defDigraphs, DigraphTbl)
import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents)
import Yi.Keymap.Vim.Ex (ExCommand, defExCommandParsers)
import Yi.Keymap.Vim.ExMap (defExMap)
import Yi.Keymap.Vim.InsertMap (defInsertMap)
import Yi.Keymap.Vim.NormalMap (defNormalMap)
import Yi.Keymap.Vim.NormalOperatorPendingMap (defNormalOperatorPendingMap)
import Yi.Keymap.Vim.Operator (VimOperator (..), defOperators)
import Yi.Keymap.Vim.ReplaceMap (defReplaceMap)
import Yi.Keymap.Vim.ReplaceSingleCharMap (defReplaceSingleMap)
import Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap)
import Yi.Keymap.Vim.StateUtils
import Yi.Keymap.Vim.Utils (selectBinding, selectPureBinding)
import Yi.Keymap.Vim.VisualMap (defVisualMap)
data VimConfig = VimConfig {
VimConfig -> Keymap
vimKeymap :: Keymap
, VimConfig -> [VimBinding]
vimBindings :: [VimBinding]
, VimConfig -> [VimOperator]
vimOperators :: [VimOperator]
, VimConfig -> [EventString -> Maybe ExCommand]
vimExCommandParsers :: [EventString -> Maybe ExCommand]
, VimConfig -> DigraphTbl
vimDigraphs :: DigraphTbl
, VimConfig -> Char -> Char
vimRelayout :: Char -> Char
}
mkKeymapSet :: Proto VimConfig -> KeymapSet
mkKeymapSet :: Proto VimConfig -> KeymapSet
mkKeymapSet = Keymap -> KeymapSet
modelessKeymapSet (Keymap -> KeymapSet)
-> (Proto VimConfig -> Keymap) -> Proto VimConfig -> KeymapSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VimConfig -> Keymap
vimKeymap (VimConfig -> Keymap)
-> (Proto VimConfig -> VimConfig) -> Proto VimConfig -> Keymap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto VimConfig -> VimConfig
forall t. Proto t -> t
extractValue
keymapSet :: KeymapSet
keymapSet :: KeymapSet
keymapSet = Proto VimConfig -> KeymapSet
mkKeymapSet Proto VimConfig
defVimConfig
defVimConfig :: Proto VimConfig
defVimConfig :: Proto VimConfig
defVimConfig = (VimConfig -> VimConfig) -> Proto VimConfig
forall a. (a -> a) -> Proto a
Proto ((VimConfig -> VimConfig) -> Proto VimConfig)
-> (VimConfig -> VimConfig) -> Proto VimConfig
forall a b. (a -> b) -> a -> b
$ \VimConfig
this -> VimConfig :: Keymap
-> [VimBinding]
-> [VimOperator]
-> [EventString -> Maybe ExCommand]
-> DigraphTbl
-> (Char -> Char)
-> VimConfig
VimConfig {
vimKeymap :: Keymap
vimKeymap = VimConfig -> Keymap
defVimKeymap VimConfig
this
, vimBindings :: [VimBinding]
vimBindings = [[VimBinding]] -> [VimBinding]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [VimOperator] -> [VimBinding]
defNormalMap (VimConfig -> [VimOperator]
vimOperators VimConfig
this)
, [VimOperator] -> [VimBinding]
defNormalOperatorPendingMap (VimConfig -> [VimOperator]
vimOperators VimConfig
this)
, [EventString -> Maybe ExCommand] -> [VimBinding]
defExMap (VimConfig -> [EventString -> Maybe ExCommand]
vimExCommandParsers VimConfig
this)
, DigraphTbl -> [VimBinding]
defInsertMap (VimConfig -> DigraphTbl
vimDigraphs VimConfig
this)
, [VimBinding]
defReplaceSingleMap
, [VimBinding]
defReplaceMap
, [VimOperator] -> [VimBinding]
defVisualMap (VimConfig -> [VimOperator]
vimOperators VimConfig
this)
, [VimBinding]
defSearchMotionMap
]
, vimOperators :: [VimOperator]
vimOperators = [VimOperator]
defOperators
, vimExCommandParsers :: [EventString -> Maybe ExCommand]
vimExCommandParsers = [EventString -> Maybe ExCommand]
defExCommandParsers
, vimDigraphs :: DigraphTbl
vimDigraphs = DigraphTbl
defDigraphs
, vimRelayout :: Char -> Char
vimRelayout = Char -> Char
forall a. a -> a
id
}
defVimKeymap :: VimConfig -> KeymapM ()
defVimKeymap :: VimConfig -> Keymap
defVimKeymap VimConfig
config = do
Event
e <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
YiM () -> Keymap
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (YiM () -> Keymap) -> YiM () -> Keymap
forall a b. (a -> b) -> a -> b
$ VimConfig -> Event -> Bool -> YiM ()
impureHandleEvent VimConfig
config Event
e Bool
True
pureEval :: VimConfig -> EventString -> EditorM ()
pureEval :: VimConfig -> EventString -> EditorM ()
pureEval VimConfig
config = [EditorM ()] -> EditorM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([EditorM ()] -> EditorM ())
-> (EventString -> [EditorM ()]) -> EventString -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event -> EditorM ()) -> [Event] -> [EditorM ()]
forall a b. (a -> b) -> [a] -> [b]
map (VimConfig -> Event -> EditorM ()
pureHandleEvent VimConfig
config) ([Event] -> [EditorM ()])
-> (EventString -> [Event]) -> EventString -> [EditorM ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventString -> [Event]
parseEvents
impureEval :: VimConfig -> EventString -> Bool -> YiM ()
impureEval :: VimConfig -> EventString -> Bool -> YiM ()
impureEval VimConfig
config EventString
s Bool
needsToConvertEvents = [YiM ()] -> YiM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [YiM ()]
actions
where actions :: [YiM ()]
actions = (Event -> YiM ()) -> [Event] -> [YiM ()]
forall a b. (a -> b) -> [a] -> [b]
map (\Event
e -> VimConfig -> Event -> Bool -> YiM ()
impureHandleEvent VimConfig
config Event
e Bool
needsToConvertEvents) ([Event] -> [YiM ()]) -> [Event] -> [YiM ()]
forall a b. (a -> b) -> a -> b
$ EventString -> [Event]
parseEvents EventString
s
pureHandleEvent :: VimConfig -> Event -> EditorM ()
pureHandleEvent :: VimConfig -> Event -> EditorM ()
pureHandleEvent VimConfig
config Event
ev
= (VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken))
-> VimConfig
-> Event
-> Bool
-> EditorM ()
forall (m :: * -> *).
MonadEditor m =>
(VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken))
-> VimConfig
-> Event
-> Bool
-> m ()
genericHandleEvent VimConfig -> [VimBinding]
allPureBindings EventString
-> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken)
selectPureBinding VimConfig
config Event
ev Bool
False
impureHandleEvent :: VimConfig -> Event -> Bool -> YiM ()
impureHandleEvent :: VimConfig -> Event -> Bool -> YiM ()
impureHandleEvent = (VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken))
-> VimConfig
-> Event
-> Bool
-> YiM ()
forall (m :: * -> *).
MonadEditor m =>
(VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken))
-> VimConfig
-> Event
-> Bool
-> m ()
genericHandleEvent VimConfig -> [VimBinding]
vimBindings EventString
-> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)
selectBinding
genericHandleEvent :: MonadEditor m => (VimConfig -> [VimBinding])
-> (EventString -> VimState -> [VimBinding]
-> MatchResult (m RepeatToken))
-> VimConfig
-> Event
-> Bool
-> m ()
genericHandleEvent :: forall (m :: * -> *).
MonadEditor m =>
(VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken))
-> VimConfig
-> Event
-> Bool
-> m ()
genericHandleEvent VimConfig -> [VimBinding]
getBindings EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken)
pick VimConfig
config Event
unconvertedEvent Bool
needsToConvertEvents = do
VimState
currentState <- EditorM VimState -> m VimState
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
let event :: Event
event = if Bool
needsToConvertEvents
then VimMode -> (Char -> Char) -> Event -> Event
convertEvent (VimState -> VimMode
vsMode VimState
currentState) (VimConfig -> Char -> Char
vimRelayout VimConfig
config) Event
unconvertedEvent
else Event
unconvertedEvent
evs :: EventString
evs = VimState -> EventString
vsBindingAccumulator VimState
currentState EventString -> EventString -> EventString
forall a. Semigroup a => a -> a -> a
<> Event -> EventString
eventToEventString Event
event
bindingMatch :: MatchResult (m RepeatToken)
bindingMatch = EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken)
pick EventString
evs VimState
currentState (VimConfig -> [VimBinding]
getBindings VimConfig
config)
prevMode :: VimMode
prevMode = VimState -> VimMode
vsMode VimState
currentState
case MatchResult (m RepeatToken)
bindingMatch of
MatchResult (m RepeatToken)
NoMatch -> EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
dropBindingAccumulatorE
MatchResult (m RepeatToken)
PartialMatch -> EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> m ()) -> EditorM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Event -> EditorM ()
accumulateBindingEventE Event
event
Event -> EditorM ()
accumulateEventE Event
event
WholeMatch m RepeatToken
action -> do
RepeatToken
repeatToken <- m RepeatToken
action
EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> m ()) -> EditorM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
EditorM ()
dropBindingAccumulatorE
Event -> EditorM ()
accumulateEventE Event
event
case RepeatToken
repeatToken of
RepeatToken
Drop -> do
EditorM ()
resetActiveRegisterE
EditorM ()
dropAccumulatorE
RepeatToken
Continue -> () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RepeatToken
Finish -> do
EditorM ()
resetActiveRegisterE
EditorM ()
flushAccumulatorE
EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> m ()) -> EditorM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
VimMode
newMode <- VimState -> VimMode
vsMode (VimState -> VimMode) -> EditorM VimState -> EditorM VimMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
case (VimMode
prevMode, VimMode
newMode) of
(Insert Char
_, Insert Char
_) -> () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Insert Char
_, VimMode
_) -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
commitUpdateTransactionB
(VimMode
_, Insert Char
_) -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
startUpdateTransactionB
(VimMode, VimMode)
_ -> () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
VimConfig -> EditorM ()
performEvalIfNecessary VimConfig
config
VimState -> EditorM ()
updateModeIndicatorE VimState
currentState
performEvalIfNecessary :: VimConfig -> EditorM ()
performEvalIfNecessary :: VimConfig -> EditorM ()
performEvalIfNecessary VimConfig
config = do
VimState
stateAfterAction <- EditorM VimState
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
(VimState -> VimState) -> EditorM ()
modifyStateE ((VimState -> VimState) -> EditorM ())
-> (VimState -> VimState) -> EditorM ()
forall a b. (a -> b) -> a -> b
$ \VimState
s -> VimState
s { vsStringToEval :: EventString
vsStringToEval = EventString
forall a. Monoid a => a
mempty }
VimConfig -> EventString -> EditorM ()
pureEval VimConfig
config (VimState -> EventString
vsStringToEval VimState
stateAfterAction)
allPureBindings :: VimConfig -> [VimBinding]
allPureBindings :: VimConfig -> [VimBinding]
allPureBindings VimConfig
config = (VimBinding -> Bool) -> [VimBinding] -> [VimBinding]
forall a. (a -> Bool) -> [a] -> [a]
filter VimBinding -> Bool
isPure ([VimBinding] -> [VimBinding]) -> [VimBinding] -> [VimBinding]
forall a b. (a -> b) -> a -> b
$ VimConfig -> [VimBinding]
vimBindings VimConfig
config
where isPure :: VimBinding -> Bool
isPure (VimBindingE EventString -> VimState -> MatchResult (EditorM RepeatToken)
_) = Bool
True
isPure VimBinding
_ = Bool
False
convertEvent :: VimMode -> (Char -> Char) -> Event -> Event
convertEvent :: VimMode -> (Char -> Char) -> Event -> Event
convertEvent (Insert Char
_) Char -> Char
f (Event (KASCII Char
c) [Modifier]
mods)
| Modifier
MCtrl Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods Bool -> Bool -> Bool
|| Modifier
MMeta Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods = Key -> [Modifier] -> Event
Event (Char -> Key
KASCII (Char -> Char
f Char
c)) [Modifier]
mods
convertEvent VimMode
Ex Char -> Char
_ Event
e = Event
e
convertEvent (Insert Char
_) Char -> Char
_ Event
e = Event
e
convertEvent VimMode
InsertNormal Char -> Char
_ Event
e = Event
e
convertEvent VimMode
InsertVisual Char -> Char
_ Event
e = Event
e
convertEvent VimMode
Replace Char -> Char
_ Event
e = Event
e
convertEvent VimMode
ReplaceSingleChar Char -> Char
_ Event
e = Event
e
convertEvent (Search VimMode
_ Direction
_) Char -> Char
_ Event
e = Event
e
convertEvent VimMode
_ Char -> Char
f (Event (KASCII Char
c) [Modifier]
mods) = Key -> [Modifier] -> Event
Event (Char -> Key
KASCII (Char -> Char
f Char
c)) [Modifier]
mods
convertEvent VimMode
_ Char -> Char
_ Event
e = Event
e
relayoutFromTo :: String -> String -> (Char -> Char)
relayoutFromTo :: String -> String -> Char -> Char
relayoutFromTo String
keysFrom String
keysTo = \Char
c ->
Char -> ((Char, Char) -> Char) -> Maybe (Char, Char) -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
c (Char, Char) -> Char
forall a b. (a, b) -> a
fst (((Char, Char) -> Bool) -> [(Char, Char)] -> Maybe (Char, Char)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) (Char -> Bool) -> ((Char, Char) -> Char) -> (Char, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Char) -> Char
forall a b. (a, b) -> b
snd)
(String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
keysTo String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper' String
keysTo)
(String
keysFrom String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper' String
keysFrom)))
where toUpper' :: Char -> Char
toUpper' Char
';' = Char
':'
toUpper' Char
a = Char -> Char
toUpper Char
a