{-# LANGUAGE DeriveGeneric #-}
module Vgrep.Key
( Chord (..)
, Key (..)
, Mod (..)
, fromVty
, key
, withModifier
)where
import Control.Applicative
import Data.Set (Set)
import qualified Data.Set as S
import GHC.Generics
import qualified Graphics.Vty.Input.Events as Vty
import Prelude hiding (Left, Right)
data Chord = Chord (Set Mod) Key
deriving (Chord -> Chord -> Bool
(Chord -> Chord -> Bool) -> (Chord -> Chord -> Bool) -> Eq Chord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chord -> Chord -> Bool
$c/= :: Chord -> Chord -> Bool
== :: Chord -> Chord -> Bool
$c== :: Chord -> Chord -> Bool
Eq, Eq Chord
Eq Chord
-> (Chord -> Chord -> Ordering)
-> (Chord -> Chord -> Bool)
-> (Chord -> Chord -> Bool)
-> (Chord -> Chord -> Bool)
-> (Chord -> Chord -> Bool)
-> (Chord -> Chord -> Chord)
-> (Chord -> Chord -> Chord)
-> Ord Chord
Chord -> Chord -> Bool
Chord -> Chord -> Ordering
Chord -> Chord -> Chord
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Chord -> Chord -> Chord
$cmin :: Chord -> Chord -> Chord
max :: Chord -> Chord -> Chord
$cmax :: Chord -> Chord -> Chord
>= :: Chord -> Chord -> Bool
$c>= :: Chord -> Chord -> Bool
> :: Chord -> Chord -> Bool
$c> :: Chord -> Chord -> Bool
<= :: Chord -> Chord -> Bool
$c<= :: Chord -> Chord -> Bool
< :: Chord -> Chord -> Bool
$c< :: Chord -> Chord -> Bool
compare :: Chord -> Chord -> Ordering
$ccompare :: Chord -> Chord -> Ordering
$cp1Ord :: Eq Chord
Ord, Int -> Chord -> ShowS
[Chord] -> ShowS
Chord -> String
(Int -> Chord -> ShowS)
-> (Chord -> String) -> ([Chord] -> ShowS) -> Show Chord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chord] -> ShowS
$cshowList :: [Chord] -> ShowS
show :: Chord -> String
$cshow :: Chord -> String
showsPrec :: Int -> Chord -> ShowS
$cshowsPrec :: Int -> Chord -> ShowS
Show, (forall x. Chord -> Rep Chord x)
-> (forall x. Rep Chord x -> Chord) -> Generic Chord
forall x. Rep Chord x -> Chord
forall x. Chord -> Rep Chord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Chord x -> Chord
$cfrom :: forall x. Chord -> Rep Chord x
Generic)
data Key
= Char Char | Space
| Esc | Backspace | Enter | Del | Tab
| Left | Right | Up | Down
| Home | End | PageUp | PageDown
deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)
data Mod
= Ctrl
| Meta
| Shift
deriving (Mod -> Mod -> Bool
(Mod -> Mod -> Bool) -> (Mod -> Mod -> Bool) -> Eq Mod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mod -> Mod -> Bool
$c/= :: Mod -> Mod -> Bool
== :: Mod -> Mod -> Bool
$c== :: Mod -> Mod -> Bool
Eq, Eq Mod
Eq Mod
-> (Mod -> Mod -> Ordering)
-> (Mod -> Mod -> Bool)
-> (Mod -> Mod -> Bool)
-> (Mod -> Mod -> Bool)
-> (Mod -> Mod -> Bool)
-> (Mod -> Mod -> Mod)
-> (Mod -> Mod -> Mod)
-> Ord Mod
Mod -> Mod -> Bool
Mod -> Mod -> Ordering
Mod -> Mod -> Mod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mod -> Mod -> Mod
$cmin :: Mod -> Mod -> Mod
max :: Mod -> Mod -> Mod
$cmax :: Mod -> Mod -> Mod
>= :: Mod -> Mod -> Bool
$c>= :: Mod -> Mod -> Bool
> :: Mod -> Mod -> Bool
$c> :: Mod -> Mod -> Bool
<= :: Mod -> Mod -> Bool
$c<= :: Mod -> Mod -> Bool
< :: Mod -> Mod -> Bool
$c< :: Mod -> Mod -> Bool
compare :: Mod -> Mod -> Ordering
$ccompare :: Mod -> Mod -> Ordering
$cp1Ord :: Eq Mod
Ord, Int -> Mod -> ShowS
[Mod] -> ShowS
Mod -> String
(Int -> Mod -> ShowS)
-> (Mod -> String) -> ([Mod] -> ShowS) -> Show Mod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mod] -> ShowS
$cshowList :: [Mod] -> ShowS
show :: Mod -> String
$cshow :: Mod -> String
showsPrec :: Int -> Mod -> ShowS
$cshowsPrec :: Int -> Mod -> ShowS
Show, (forall x. Mod -> Rep Mod x)
-> (forall x. Rep Mod x -> Mod) -> Generic Mod
forall x. Rep Mod x -> Mod
forall x. Mod -> Rep Mod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mod x -> Mod
$cfrom :: forall x. Mod -> Rep Mod x
Generic)
fromVty :: Vty.Event -> Maybe Chord
fromVty :: Event -> Maybe Chord
fromVty = \case
Vty.EvKey Key
k [Modifier]
ms -> (Set Mod -> Key -> Chord)
-> Maybe (Set Mod) -> Maybe Key -> Maybe Chord
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Set Mod -> Key -> Chord
Chord ([Modifier] -> Maybe (Set Mod)
mapModifiers [Modifier]
ms) (Key -> Maybe Key
mapKey Key
k)
Event
_otherwise -> Maybe Chord
forall a. Maybe a
Nothing
mapModifiers :: [Vty.Modifier] -> Maybe (Set Mod)
mapModifiers :: [Modifier] -> Maybe (Set Mod)
mapModifiers = Set Mod -> Maybe (Set Mod)
forall a. a -> Maybe a
Just (Set Mod -> Maybe (Set Mod))
-> ([Modifier] -> Set Mod) -> [Modifier] -> Maybe (Set Mod)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mod] -> Set Mod
forall a. Ord a => [a] -> Set a
S.fromList ([Mod] -> Set Mod)
-> ([Modifier] -> [Mod]) -> [Modifier] -> Set Mod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modifier -> Mod) -> [Modifier] -> [Mod]
forall a b. (a -> b) -> [a] -> [b]
map Modifier -> Mod
go
where
go :: Modifier -> Mod
go = \case
Modifier
Vty.MCtrl -> Mod
Ctrl
Modifier
Vty.MShift -> Mod
Shift
Modifier
Vty.MMeta -> Mod
Meta
Modifier
Vty.MAlt -> Mod
Meta
mapKey :: Vty.Key -> Maybe Key
mapKey :: Key -> Maybe Key
mapKey = \case
Vty.KChar Char
' ' -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Space
Key
Vty.KEsc -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Esc
Key
Vty.KBS -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Backspace
Key
Vty.KEnter -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Enter
Key
Vty.KDel -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Del
Vty.KChar Char
'\t' -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Tab
Key
Vty.KLeft -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Left
Key
Vty.KRight -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Right
Key
Vty.KUp -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Up
Key
Vty.KDown -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Down
Key
Vty.KHome -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
Home
Key
Vty.KEnd -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
End
Key
Vty.KPageUp -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
PageUp
Key
Vty.KPageDown -> Key -> Maybe Key
forall a. a -> Maybe a
Just Key
PageDown
Vty.KChar Char
c -> Key -> Maybe Key
forall a. a -> Maybe a
Just (Char -> Key
Char Char
c)
Key
_otherwise -> Maybe Key
forall a. Maybe a
Nothing
key :: Key -> Chord
key :: Key -> Chord
key = Set Mod -> Key -> Chord
Chord Set Mod
forall a. Set a
S.empty
withModifier :: Chord -> Mod -> Chord
withModifier :: Chord -> Mod -> Chord
withModifier (Chord Set Mod
ms Key
k) Mod
m = Set Mod -> Key -> Chord
Chord (Mod -> Set Mod -> Set Mod
forall a. Ord a => a -> Set a -> Set a
S.insert Mod
m Set Mod
ms) Key
k