    {-# 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
      e <- I Event Action Event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    m event
    anyEvent
      write $ impureHandleEvent config e 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
        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 = 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 = VimState -> EventString
    vsBindingAccumulator VimState
    currentState EventString -> EventString -> EventString
    forall a. Semigroup a => a -> a -> a
    <> Event -> EventString
    eventToEventString Event
    event
            bindingMatch = EventString
    -> VimState -> [VimBinding] -> MatchResult (m RepeatToken)
    pick EventString
    evs VimState
    currentState (VimConfig -> [VimBinding]
    getBindings VimConfig
    config)
            prevMode = VimState -> VimMode
    vsMode VimState
    currentState

        case 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 <- m RepeatToken
    action
                withEditor $ do
                    dropBindingAccumulatorE
                    accumulateEventE event
                    case 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

        withEditor $ do
            newMode <- vsMode <$> getEditorDyn

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

            performEvalIfNecessary config
            updateModeIndicatorE currentState

    performEvalIfNecessary :: VimConfig -> EditorM ()
    performEvalIfNecessary :: VimConfig -> EditorM ()
    performEvalIfNecessary VimConfig
    config = do
        stateAfterAction <- EditorM VimState
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn

        -- see comment for 'pureEval'
        modifyStateE $ \VimState
    s -> VimState
    s { vsStringToEval = mempty }
        pureEval config (vsStringToEval 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