blob: 5e5856f171500daf5340fc3531b69259992ed106 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
module Daffm.Keymap where
import Daffm.Types
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import qualified Data.Text as Text
import qualified Graphics.Vty as V
showKeySequence :: KeySequence -> Text.Text
showKeySequence = Text.intercalate "" . map showKey
-- TODO: More chars
showKey :: Key -> Text.Text
showKey (V.KChar ' ') = "<space>"
showKey (V.KChar '\t') = "<tab>"
showKey (V.KChar c) = Text.singleton c
showKey V.KEnter = "<cr>"
showKey V.KEsc = "<esc>"
showKey V.KBS = "<bs>"
showKey _ = ""
matchKeySequence :: Keymap -> KeySequence -> KeyMatchResult
matchKeySequence keymaps keys
| Map.member keys keymaps =
MatchSuccess . fromMaybe CmdNoop $ Map.lookup keys keymaps
| otherwise = partial keymaps keys
where
partial _ [] = MatchFailure
partial (Map.null -> True) _ = MatchFailure
partial keymaps' keys' = if hasMatch then MatchPartial else MatchFailure
where
hasMatch = any (startsWith keys' . fst) (Map.toList keymaps')
startsWith ls1 ls2 = ls1 == take (length ls1) ls2
parseKeySequence :: Text.Text -> Maybe [Key]
parseKeySequence keytxt = parse keytxt []
where
parse k keys = case k of
"" -> pure keys
(Text.stripPrefix "<tab>" -> (Just rest')) -> parse rest' $ keys <> [V.KChar '\t']
(Text.stripPrefix "<space>" -> (Just rest')) -> parse rest' $ keys <> [V.KChar ' ']
(Text.stripPrefix "<bs>" -> (Just rest')) -> parse rest' $ keys <> [V.KBS]
(Text.stripPrefix "<cr>" -> (Just rest')) -> parse rest' $ keys <> [V.KEnter]
(Text.stripPrefix "<esc>" -> (Just rest')) -> parse rest' $ keys <> [V.KEsc]
(Text.splitAt 1 -> (c, rest)) -> do
ch <- fst <$> Text.uncons c
parse rest $ keys <> [V.KChar ch]
|
