{-# 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 (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 :: String -> Event
stringToEvent String
"<" = String -> Event
forall a. HasCallStack => String -> a
error String
"Invalid event string \"<\""
stringToEvent String
"<C-@>" = (Key -> [Modifier] -> Event
Event (Char -> Key
KASCII Char
' ') [Modifier
MCtrl])
stringToEvent s :: String
s@(Char
'<':Char
'C':Char
'-':String
_) = Int -> String -> (Event -> Event) -> Event
stringToEvent' Int
3 String
s Event -> Event
ctrl
stringToEvent s :: String
s@(Char
'<':Char
'M':Char
'-':String
_) = Int -> String -> (Event -> Event) -> Event
stringToEvent' Int
3 String
s Event -> Event
meta
stringToEvent s :: String
s@(Char
'<':Char
'a':Char
'-':String
_) = Int -> String -> (Event -> Event) -> Event
stringToEvent' Int
3 String
s Event -> Event
meta
stringToEvent String
"<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
$ String -> Int
forall a. Read a => String -> 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
+ String -> Int
forall a. Read a => String -> a
read [Char
d])
stringToEvent s :: String
s@(Char
'<':String
_) = Int -> String -> (Event -> Event) -> Event
stringToEvent' Int
1 String
s Event -> Event
forall a. a -> a
id
stringToEvent String
s = String -> Event
forall a. HasCallStack => String -> a
error (String
"Invalid event string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s)

stringToEvent' :: Int -> String -> (Event -> Event) -> Event
stringToEvent' :: Int -> String -> (Event -> Event) -> Event
stringToEvent' Int
toDrop String
inputString Event -> Event
modifier =
  let analyzedString :: String
analyzedString = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
toDrop String
inputString
  in case String
analyzedString of
    [Char
c,Char
'>'] -> Event -> Event
modifier (Char -> Event
char Char
c)
    String
_ -> if String -> Char
forall a. [a] -> a
last String
analyzedString Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>'
         then String -> Event
forall a. HasCallStack => String -> a
error (String
"Invalid event string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
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) -> (String -> Text) -> String -> EventString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> EventString) -> String -> EventString
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init String
analyzedString) Map EventString Key
specMap of
           Just Key
k -> Event -> Event
modifier (Key -> [Modifier] -> Event
Event Key
k [])
           Maybe Key
Nothing -> String -> Event
forall a. HasCallStack => String -> a
error (String -> Event) -> String -> Event
forall a b. (a -> b) -> a -> b
$ String
"Couldn't convert string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
inputString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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]
_ -> String -> EventString
forall a. HasCallStack => String -> a
error (String -> EventString) -> String -> EventString
forall a b. (a -> b) -> a -> b
$ String
"Couldn't convert event <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Event -> String
forall a. Show a => a -> String
show Event
v
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> to string, because of unknown modifiers"
    Maybe EventString
Nothing -> String -> EventString
forall a. HasCallStack => String -> a
error (String -> EventString) -> String -> EventString
forall a b. (a -> b) -> a -> b
$ String
"Couldn't convert event <" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Event -> String
forall a. Show a => a -> String
show Event
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> 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], String) -> [Event]
forall a b. (a, b) -> a
fst (([Event], String) -> [Event])
-> (String -> ([Event], String)) -> String -> [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Event], String) -> Char -> ([Event], String))
-> ([Event], String) -> String -> ([Event], String)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Event], String) -> Char -> ([Event], String)
go ([], []) (String -> [Event]) -> String -> [Event]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
    where go :: ([Event], String) -> Char -> ([Event], String)
go ([Event]
evs, String
s) Char
'\n' = ([Event]
evs, String
s)
          go ([Event]
evs, []) Char
'<' = ([Event]
evs, String
"<")
          go ([Event]
evs, []) Char
c = ([Event]
evs [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++ [Char -> Event
char Char
c], [])
          go ([Event]
evs, String
s) Char
'>' = ([Event]
evs [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++ [String -> Event
stringToEvent (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">")], [])
          go ([Event]
evs, String
s) Char
c = ([Event]
evs, String
s String -> String -> String
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  -> String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
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)