{-# 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
$ \this :: 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 config :: 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 config :: 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 config :: VimConfig
config s :: EventString
s needsToConvertEvents :: 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 (\e :: 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 config :: VimConfig
config ev :: 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 :: (VimConfig -> [VimBinding])
-> (EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken))
-> VimConfig
-> Event
-> Bool
-> m ()
genericHandleEvent getBindings :: VimConfig -> [VimBinding]
getBindings pick :: EventString
-> VimState -> [VimBinding] -> MatchResult (m RepeatToken)
pick config :: VimConfig
config unconvertedEvent :: Event
unconvertedEvent needsToConvertEvents :: 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
NoMatch -> EditorM () -> m ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
dropBindingAccumulatorE
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 action :: 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
Drop -> do
EditorM ()
resetActiveRegisterE
EditorM ()
dropAccumulatorE
Continue -> () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 _, Insert _) -> () -> EditorM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Insert _, _) -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
commitUpdateTransactionB
(_, Insert _) -> BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ()
startUpdateTransactionB
_ -> () -> 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 config :: 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
$ \s :: 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 config :: 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 _) = Bool
True
isPure _ = Bool
False
convertEvent :: VimMode -> (Char -> Char) -> Event -> Event
convertEvent :: VimMode -> (Char -> Char) -> Event -> Event
convertEvent (Insert _) f :: Char -> Char
f (Event (KASCII c :: Char
c) mods :: [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 Ex _ e :: Event
e = Event
e
convertEvent (Insert _) _ e :: Event
e = Event
e
convertEvent InsertNormal _ e :: Event
e = Event
e
convertEvent InsertVisual _ e :: Event
e = Event
e
convertEvent Replace _ e :: Event
e = Event
e
convertEvent ReplaceSingleChar _ e :: Event
e = Event
e
convertEvent (Search _ _) _ e :: Event
e = Event
e
convertEvent _ f :: Char -> Char
f (Event (KASCII c :: Char
c) mods :: [Modifier]
mods) = Key -> [Modifier] -> Event
Event (Char -> Key
KASCII (Char -> Char
f Char
c)) [Modifier]
mods
convertEvent _ _ e :: Event
e = Event
e
relayoutFromTo :: String -> String -> (Char -> Char)
relayoutFromTo :: String -> String -> Char -> Char
relayoutFromTo keysFrom :: String
keysFrom keysTo :: String
keysTo = \c :: 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' ';' = ':'
toUpper' a :: Char
a = Char -> Char
toUpper Char
a