{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Keys
(
module Yi.Event,
module Yi.Interact,
printableChar, textChar,
charOf, shift, meta, ctrl, super, hyper, spec, char,
(>>!), (>>=!), (?>>), (?>>!), (?*>>), (?*>>!),
ctrlCh, metaCh, hyperCh,
optMod,
pString
) where
import Prelude hiding (error)
import Control.Monad (unless)
import qualified Control.Monad.Fail as Fail
import Data.Char (isAlpha, isPrint, toUpper)
import Data.List (nub, sort)
import Yi.Debug (error)
import Yi.Event (Event (..), Key (..), Modifier (..), eventToChar, prettyEvent)
import Yi.Interact hiding (write)
import Yi.Keymap (Action, KeymapM, YiAction, write)
printableChar :: (Fail.MonadFail m, MonadInteract m w Event) => m Char
printableChar :: m Char
printableChar = do
Event (KASCII Char
c) [] <- m Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char -> Bool
isPrint Char
c) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unprintable character"
Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
textChar :: KeymapM Char
textChar :: KeymapM Char
textChar = do
Event (KASCII Char
c) [] <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
Char -> KeymapM Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
pString :: (MonadInteract m w Event) => String -> m [Event]
pString :: String -> m [Event]
pString = [Event] -> m [Event]
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
[event] -> m [event]
events ([Event] -> m [Event])
-> (String -> [Event]) -> String -> m [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Event) -> String -> [Event]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Event
char
charOf :: (Fail.MonadFail m, MonadInteract m w Event) => (Event -> Event) -> Char -> Char -> m Char
charOf :: (Event -> Event) -> Char -> Char -> m Char
charOf Event -> Event
modifier Char
l Char
h =
do Event (KASCII Char
c) [Modifier]
_ <- Event -> Event -> m Event
forall e (m :: * -> *) w.
(Ord e, MonadInteract m w e) =>
e -> e -> m e
eventBetween (Event -> Event
modifier (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
l) (Event -> Event
modifier (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
h)
Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
shift,ctrl,meta,super,hyper :: Event -> Event
shift :: Event -> Event
shift (Event (KASCII Char
c) [Modifier]
ms) | Char -> Bool
isAlpha Char
c = Key -> [Modifier] -> Event
Event (Char -> Key
KASCII (Char -> Char
toUpper Char
c)) [Modifier]
ms
| Bool
otherwise = Text -> Event
forall a. Text -> a
error Text
"shift: unhandled event"
shift (Event Key
k [Modifier]
ms) = Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort (Modifier
MShiftModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
ms)
ctrl :: Event -> Event
ctrl (Event Key
k [Modifier]
ms) = Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort (Modifier
MCtrlModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
ms)
meta :: Event -> Event
meta (Event Key
k [Modifier]
ms) = Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort (Modifier
MMetaModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
ms)
super :: Event -> Event
super (Event Key
k [Modifier]
ms) = Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort (Modifier
MSuperModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
ms)
hyper :: Event -> Event
hyper (Event Key
k [Modifier]
ms) = Key -> [Modifier] -> Event
Event Key
k ([Modifier] -> Event) -> [Modifier] -> Event
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort (Modifier
MHyperModifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
:[Modifier]
ms)
char :: Char -> Event
char :: Char -> Event
char Char
'\t' = Key -> [Modifier] -> Event
Event Key
KTab []
char Char
'\r' = Key -> [Modifier] -> Event
Event Key
KEnter []
char Char
'\n' = Key -> [Modifier] -> Event
Event Key
KEnter []
char Char
c = Key -> [Modifier] -> Event
Event (Char -> Key
KASCII Char
c) []
ctrlCh :: Char -> Event
ctrlCh :: Char -> Event
ctrlCh = Event -> Event
ctrl (Event -> Event) -> (Char -> Event) -> Char -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Event
char
metaCh :: Char -> Event
metaCh :: Char -> Event
metaCh = Event -> Event
meta (Event -> Event) -> (Char -> Event) -> Char -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Event
char
hyperCh :: Char -> Event
hyperCh :: Char -> Event
hyperCh = Event -> Event
hyper (Event -> Event) -> (Char -> Event) -> Char -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Event
char
optMod ::(Fail.MonadFail m, MonadInteract m w Event) => (Event -> Event) -> Event -> m Event
optMod :: (Event -> Event) -> Event -> m Event
optMod Event -> Event
f Event
ev = [Event] -> m Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Event
ev, Event -> Event
f Event
ev]
spec :: Key -> Event
spec :: Key -> Event
spec Key
k = Key -> [Modifier] -> Event
Event Key
k []
(>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> a -> m ()
m b
p >>! :: m b -> a -> m ()
>>! a
act = m b
p m b -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write a
act
(>>=!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> (b -> a) -> m ()
m b
p >>=! :: m b -> (b -> a) -> m ()
>>=! b -> a
act = m b
p m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (a -> m ()) -> (b -> a) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
act
(?>>) :: (MonadInteract m action Event) => Event -> m a -> m a
Event
ev ?>> :: Event -> m a -> m a
?>> m a
proc = Event -> m Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
event -> m event
event Event
ev m Event -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
proc
(?>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m ()
Event
ev ?>>! :: Event -> a -> m ()
?>>! a
act = Event -> m Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
event -> m event
event Event
ev m Event -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write a
act
(?*>>) :: (MonadInteract m action Event) => [Event] -> m a -> m a
[Event]
ev ?*>> :: [Event] -> m a -> m a
?*>> m a
proc = [Event] -> m [Event]
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
[event] -> m [event]
events [Event]
ev m [Event] -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
proc
(?*>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => [Event] -> a -> m ()
[Event]
ev ?*>>! :: [Event] -> a -> m ()
?*>>! a
act = [Event] -> m [Event]
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
[event] -> m [event]
events [Event]
ev m [Event] -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write a
act
infixl 1 >>!
infixl 1 >>=!
infixr 0 ?>>!
infixr 0 ?>>
infixr 0 ?*>>!
infixr 0 ?*>>