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

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

    module Yi.Keymap.Vim.EventUtils
      ( stringToEvent
      , eventToEventString
      , parseEvents
      , stringToRepeatableAction
      , normalizeCount
      , splitCountedCommand
      ) where

    import           Data.Char            (isDigit, toUpper)
    import           Data.List            (foldl')
    import qualified Data.Map             as M (Map, fromList, lookup)
    import           Data.Monoid          ((<>))
    import qualified Data.Text            as T (break, cons, null, pack, singleton, snoc, span, unpack)
    import           Data.Tuple           (swap)
    import           Yi.Event
    import           Yi.Keymap.Keys       (char, ctrl, meta, spec)
    import           Yi.Keymap.Vim.Common (EventString (Ev), RepeatableAction (RepeatableAction))
    import           Yi.String            (showT)

    specMap :: M.Map EventString Key
    specMap :: Map EventString Key
    specMap = [(EventString, Key)] -> Map EventString Key
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(EventString, Key)]
    specList

    invSpecMap :: M.Map Key EventString
    invSpecMap :: Map Key EventString
    invSpecMap = [(Key, EventString)] -> Map Key EventString
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Key, EventString)] -> Map Key EventString)
    -> [(Key, EventString)] -> Map Key EventString
    forall a b. (a -> b) -> a -> b
    $ ((EventString, Key) -> (Key, EventString))
    -> [(EventString, Key)] -> [(Key, EventString)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (EventString, Key) -> (Key, EventString)
    forall a b. (a, b) -> (b, a)
    swap [(EventString, Key)]
    specList

    specList :: [(EventString, Key)]
    specList :: [(EventString, Key)]
    specList =
        [ (Text -> EventString
    Ev Text
    "Esc", Key
    KEsc)
        , (Text -> EventString
    Ev Text
    "CR", Key
    KEnter)
        , (Text -> EventString
    Ev Text
    "BS", Key
    KBS)
        , (Text -> EventString
    Ev Text
    "Tab", Key
    KTab)
        , (Text -> EventString
    Ev Text
    "Down", Key
    KDown)
        , (Text -> EventString
    Ev Text
    "Up", Key
    KUp)
        , (Text -> EventString
    Ev Text
    "Left", Key
    KLeft)
        , (Text -> EventString
    Ev Text
    "Right", Key
    KRight)
        , (Text -> EventString
    Ev Text
    "PageUp", Key
    KPageUp)
        , (Text -> EventString
    Ev Text
    "PageDown", Key
    KPageDown)
        , (Text -> EventString
    Ev Text
    "Home", Key
    KHome)
        , (Text -> EventString
    Ev Text
    "End", Key
    KEnd)
        , (Text -> EventString
    Ev Text
    "Ins", Key
    KIns)
        , (Text -> EventString
    Ev Text
    "Del", Key
    KDel)
        ]

    stringToEvent :: String -> Event
    stringToEvent :: [Char] -> Event
    stringToEvent [Char]
    "<" = [Char] -> Event
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Invalid event string \"<\""
    stringToEvent [Char]
    "<C-@>" = (Key -> [Modifier] -> Event
    Event (Char -> Key
    KASCII Char
    ' ') [Modifier
    MCtrl])
    stringToEvent s :: [Char]
    s@(Char
    '<':Char
    'C':Char
    '-':[Char]
    _) = Int -> [Char] -> (Event -> Event) -> Event
    stringToEvent' Int
    3 [Char]
    s Event -> Event
    ctrl
    stringToEvent s :: [Char]
    s@(Char
    '<':Char
    'M':Char
    '-':[Char]
    _) = Int -> [Char] -> (Event -> Event) -> Event
    stringToEvent' Int
    3 [Char]
    s Event -> Event
    meta
    stringToEvent s :: [Char]
    s@(Char
    '<':Char
    'a':Char
    '-':[Char]
    _) = Int -> [Char] -> (Event -> Event) -> Event
    stringToEvent' Int
    3 [Char]
    s Event -> Event
    meta
    stringToEvent [Char]
    "<lt>" = Char -> Event
    char Char
    '<'
    stringToEvent [Char
    c] = Char -> Event
    char Char
    c
    stringToEvent (Char
    '<':Char
    'F':Char
    d:Char
    '>':[]) | Char -> Bool
    isDigit Char
    d = Key -> Event
    spec (Int -> Key
    KFun (Int -> Key) -> Int -> Key
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Int
    forall a. Read a => [Char] -> a
    read [Char
    d])
    stringToEvent (Char
    '<':Char
    'F':Char
    '1':Char
    d:Char
    '>':[]) | Char -> Bool
    isDigit Char
    d = Key -> Event
    spec (Int -> Key
    KFun (Int -> Key) -> Int -> Key
    forall a b. (a -> b) -> a -> b
    $ Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Char] -> Int
    forall a. Read a => [Char] -> a
    read [Char
    d])
    stringToEvent s :: [Char]
    s@(Char
    '<':[Char]
    _) = Int -> [Char] -> (Event -> Event) -> Event
    stringToEvent' Int
    1 [Char]
    s Event -> Event
    forall a. a -> a
    id
    stringToEvent [Char]
    s = [Char] -> Event
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Invalid event string " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    s)

    stringToEvent' :: Int -> String -> (Event -> Event) -> Event
    stringToEvent' :: Int -> [Char] -> (Event -> Event) -> Event
    stringToEvent' Int
    toDrop [Char]
    inputString Event -> Event
    modifier =
      let analyzedString :: [Char]
    analyzedString = Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    drop Int
    toDrop [Char]
    inputString
      in case [Char]
    analyzedString of
        [Char
    c,Char
    '>'] -> Event -> Event
    modifier (Char -> Event
    char Char
    c)
        [Char]
    _ -> if [Char] -> Char
    forall a. HasCallStack => [a] -> a
    last [Char]
    analyzedString Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '>'
             then [Char] -> Event
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Invalid event string " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    inputString)
             else case EventString -> Map EventString Key -> Maybe Key
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text -> EventString
    Ev (Text -> EventString) -> ([Char] -> Text) -> [Char] -> EventString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Text
    T.pack ([Char] -> EventString) -> [Char] -> EventString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    init [Char]
    analyzedString) Map EventString Key
    specMap of
               Just Key
    k -> Event -> Event
    modifier (Key -> [Modifier] -> Event
    Event Key
    k [])
               Maybe Key
    Nothing -> [Char] -> Event
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Event) -> [Char] -> Event
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Couldn't convert string " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    inputString [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " to event"

    eventToEventString :: Event -> EventString
    eventToEventString :: Event -> EventString
    eventToEventString Event
    e = case Event
    e of
      Event (KASCII Char
    '<') []       -> Text -> EventString
    Ev Text
    "<lt>"
      Event (KASCII Char
    ' ') [Modifier
    MCtrl]  -> Text -> EventString
    Ev Text
    "<C-@>"
      Event (KASCII Char
    c)   []       -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Char -> Text
    T.singleton Char
    c
      Event (KASCII Char
    c)   [Modifier
    MCtrl]  -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Modifier -> Char -> Text
    mkMod Modifier
    MCtrl Char
    c
      Event (KASCII Char
    c)   [Modifier
    MMeta]  -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Modifier -> Char -> Text
    mkMod Modifier
    MMeta Char
    c
      Event (KASCII Char
    c)   [Modifier
    MShift] -> Text -> EventString
    Ev (Text -> EventString) -> (Char -> Text) -> Char -> EventString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Text
    T.singleton (Char -> EventString) -> Char -> EventString
    forall a b. (a -> b) -> a -> b
    $ Char -> Char
    toUpper Char
    c
      Event (KFun Int
    x)     []       -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Text
    "<F" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showT Int
    x Text -> Char -> Text
    `T.snoc` Char
    '>'
      v :: Event
    v@(Event      Key
    k    [Modifier]
    mods)    -> case Key -> Map Key EventString -> Maybe EventString
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Key
    k Map Key EventString
    invSpecMap of
        Just (Ev Text
    s) -> case [Modifier]
    mods of
          []      -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Char
    '<' Char -> Text -> Text
    `T.cons` Text
    s Text -> Char -> Text
    `T.snoc` Char
    '>'
          [Modifier
    MCtrl] -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Text
    "<C-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s Text -> Char -> Text
    `T.snoc` Char
    '>'
          [Modifier
    MMeta] -> Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Text
    "<M-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s Text -> Char -> Text
    `T.snoc` Char
    '>'
          [Modifier]
    _ -> [Char] -> EventString
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> EventString) -> [Char] -> EventString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Couldn't convert event <" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Event -> [Char]
    forall a. Show a => a -> [Char]
    show Event
    v
                       [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "> to string, because of unknown modifiers"
        Maybe EventString
    Nothing -> [Char] -> EventString
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> EventString) -> [Char] -> EventString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Couldn't convert event <" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Event -> [Char]
    forall a. Show a => a -> [Char]
    show Event
    v [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "> to string"

      where
        f :: Modifier -> Char
    f Modifier
    MCtrl = Char
    'C'
        f Modifier
    MMeta = Char
    'M'
        f Modifier
    _     = Char
    '×'
        mkMod :: Modifier -> Char -> Text
    mkMod Modifier
    m Char
    c = Char
    '<' Char -> Text -> Text
    `T.cons` Modifier -> Char
    f Modifier
    m Char -> Text -> Text
    `T.cons` Char
    '-'
                    Char -> Text -> Text
    `T.cons` Char
    c Char -> Text -> Text
    `T.cons` Char -> Text
    T.singleton Char
    '>'

    parseEvents :: EventString -> [Event]
    parseEvents :: EventString -> [Event]
    parseEvents (Ev Text
    x) = ([Event], [Char]) -> [Event]
    forall a b. (a, b) -> a
    fst (([Event], [Char]) -> [Event])
    -> ([Char] -> ([Event], [Char])) -> [Char] -> [Event]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Event], [Char]) -> Char -> ([Event], [Char]))
    -> ([Event], [Char]) -> [Char] -> ([Event], [Char])
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([Event], [Char]) -> Char -> ([Event], [Char])
    go ([], []) ([Char] -> [Event]) -> [Char] -> [Event]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    x
        where go :: ([Event], [Char]) -> Char -> ([Event], [Char])
    go ([Event]
    evs, [Char]
    s) Char
    '\n' = ([Event]
    evs, [Char]
    s)
              go ([Event]
    evs, []) Char
    '<' = ([Event]
    evs, [Char]
    "<")
              go ([Event]
    evs, []) Char
    c = ([Event]
    evs [Event] -> [Event] -> [Event]
    forall a. [a] -> [a] -> [a]
    ++ [Char -> Event
    char Char
    c], [])
              go ([Event]
    evs, [Char]
    s) Char
    '>' = ([Event]
    evs [Event] -> [Event] -> [Event]
    forall a. [a] -> [a] -> [a]
    ++ [[Char] -> Event
    stringToEvent ([Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ">")], [])
              go ([Event]
    evs, [Char]
    s) Char
    c = ([Event]
    evs, [Char]
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    c])

    stringToRepeatableAction :: EventString -> RepeatableAction
    stringToRepeatableAction :: EventString -> RepeatableAction
    stringToRepeatableAction EventString
    s = Int -> EventString -> RepeatableAction
    RepeatableAction Int
    count EventString
    command
        where (Int
    count, EventString
    command) = EventString -> (Int, EventString)
    splitCountedCommand EventString
    s

    splitCountedCommand :: EventString -> (Int, EventString)
    splitCountedCommand :: EventString -> (Int, EventString)
    splitCountedCommand (Ev Text
    s) = (Int
    count, Text -> EventString
    Ev Text
    commandString)
      where (Text
    countString, Text
    commandString) = (Char -> Bool) -> Text -> (Text, Text)
    T.span Char -> Bool
    isDigit Text
    s
            count :: Int
    count = case Text
    countString of
              Text
    "" -> Int
    1
              Text
    x  -> [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> [Char] -> Int
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack Text
    x

    -- 2d3w -> 6dw
    -- 6dw -> 6dw
    -- dw -> dw
    normalizeCount :: EventString -> EventString
    normalizeCount :: EventString -> EventString
    normalizeCount EventString
    s =
      if Text -> Bool
    T.null Text
    countedObject
      then EventString
    s
      else Text -> EventString
    Ev (Text -> EventString) -> Text -> EventString
    forall a b. (a -> b) -> a -> b
    $ Int -> Text
    forall a. Show a => a -> Text
    showT (Int
    operatorCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    objectCount) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    operator Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    object
        where (Int
    operatorCount, Ev Text
    rest1) = EventString -> (Int, EventString)
    splitCountedCommand EventString
    s
              (Text
    operator, Text
    countedObject) = (Char -> Bool) -> Text -> (Text, Text)
    T.break Char -> Bool
    isDigit Text
    rest1
              (Int
    objectCount, Ev Text
    object) = EventString -> (Int, EventString)
    splitCountedCommand (Text -> EventString
    Ev Text
    countedObject)