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

-- |
-- Module      :  Yi.Keymap.Vim
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The vim keymap.

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

-- This is not in Yi.Keymap.Vim.Eval to avoid circular dependency:
-- eval needs to know about bindings, which contains normal bindings,
-- which contains '.', which needs to eval things
-- So as a workaround '.' just saves a string that needs eval in VimState
-- and the actual evaluation happens in impureHandleEvent
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 a. EditorM a -> m a
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 a. EditorM a -> m a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
dropBindingAccumulatorE
        MatchResult (m RepeatToken)
PartialMatch -> 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
$ do
            Event -> EditorM ()
accumulateBindingEventE Event
event
            Event -> EditorM ()
accumulateEventE Event
event
        WholeMatch m RepeatToken
action -> do
            RepeatToken
repeatToken <- m RepeatToken
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
$ do
                EditorM ()
dropBindingAccumulatorE
                Event -> EditorM ()
accumulateEventE Event
event
                case RepeatToken
repeatToken of
                    RepeatToken
Drop -> do
                        EditorM ()
resetActiveRegisterE
                        EditorM ()
dropAccumulatorE
                    RepeatToken
Continue -> () -> EditorM ()
forall a. a -> EditorM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    RepeatToken
Finish -> do
                        EditorM ()
resetActiveRegisterE
                        EditorM ()
flushAccumulatorE

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

        -- TODO: we should introduce some hook mechanism like autocommands in vim
        case (VimMode
prevMode, VimMode
newMode) of
            (Insert Char
_, Insert Char
_) -> () -> EditorM ()
forall a. a -> EditorM a
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 a. a -> EditorM a
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

    -- see comment for 'pureEval'
    (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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods Bool -> Bool -> Bool
|| Modifier
MMeta Modifier -> [Modifier] -> Bool
forall a. Eq a => a -> [a] -> 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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> [a] -> [b]
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