{-# LANGUAGE DeriveGeneric #-}
-- | Basic definitions for 'Key's, 'Mod'ifiers, and 'Chord's of 'Key's and
-- 'Mod'ifiers. We can read key 'Chord's from "Graphics.Vty" 'Vty.EvKey' events
-- using 'fromVty'.
--
-- This module is intended for qualified import:
--
-- > import qualified Vgrep.Key as Key
--
-- We define our own 'Key' and 'Mod' types rather than using "Graphics.Vty"'s
-- 'Vty.Key' and 'Vty.Modifier', because it simplifies parsing (of keys like
-- 'Space' and 'Tab', which are represented as @' '@ and @'\t'@ in
-- "Graphics.Vty"), and because a 'Set' of 'Mod's is simpler to check for
-- equality than a list of 'Vty.Modifier's.
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)


-- | A chord of keys and modifiers pressed simultaneously.
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)


-- | Reads the key and modifiers from an 'Vty.Event'. Non-key events and events
-- with unknown keys are mapped to 'Nothing'.
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


-- | Build a 'Chord' from a single 'Key'
key :: Key -> Chord
key :: Key -> Chord
key = Set Mod -> Key -> Chord
Chord Set Mod
forall a. Set a
S.empty

-- | Add a 'Mod'ifier to a 'Chord'
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