{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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
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)