{-# 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 c :: 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 "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 c :: 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 modifier :: Event -> Event
modifier l :: Char
l h :: Char
h =
do Event (KASCII c :: Char
c) _ <- 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 c :: Char
c) ms :: [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 "shift: unhandled event"
shift (Event k :: Key
k ms :: [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 k :: Key
k ms :: [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 k :: Key
k ms :: [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 k :: Key
k ms :: [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 k :: Key
k ms :: [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 '\t' = Key -> [Modifier] -> Event
Event Key
KTab []
char '\r' = Key -> [Modifier] -> Event
Event Key
KEnter []
char '\n' = Key -> [Modifier] -> Event
Event Key
KEnter []
char c :: 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 f :: Event -> Event
f ev :: 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 k :: Key
k = Key -> [Modifier] -> Event
Event Key
k []
(>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> a -> m ()
p :: m b
p >>! :: m b -> a -> m ()
>>! act :: 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 ()
p :: m b
p >>=! :: m b -> (b -> a) -> m ()
>>=! act :: 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
ev :: Event
ev ?>> :: Event -> m a -> m a
?>> proc :: 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 ()
ev :: Event
ev ?>>! :: Event -> a -> m ()
?>>! act :: 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
ev :: [Event]
ev ?*>> :: [Event] -> m a -> m a
?*>> proc :: 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 ()
ev :: [Event]
ev ?*>>! :: [Event] -> a -> m ()
?*>>! act :: 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 ?*>>