{-# 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
$ \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

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

        -- TODO: we should introduce some hook mechanism like autocommands in vim
        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

    -- see comment for 'pureEval'
    (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