{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Monomer.Widgets.Containers.Keystroke (
KeystrokeCfg,
keystroke,
keystroke_
) where
import Debug.Trace (traceShow)
import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (^..), (.~), (%~), _1, at, folded)
import Control.Lens.TH (abbreviatedFields, makeLensesWith)
import Data.Bifunctor (first)
import Data.Char (chr, isAscii, isPrint, ord)
import Data.Default
import Data.List (foldl')
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Map as M
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T
import Monomer.Widgets.Container
import qualified Monomer.Lens as L
newtype KeystrokeCfg = KeystrokeCfg {
KeystrokeCfg -> Maybe Bool
_kscIgnoreChildren :: Maybe Bool
}
instance Default KeystrokeCfg where
def :: KeystrokeCfg
def = KeystrokeCfg :: Maybe Bool -> KeystrokeCfg
KeystrokeCfg {
_kscIgnoreChildren :: Maybe Bool
_kscIgnoreChildren = Maybe Bool
forall a. Maybe a
Nothing
}
instance Semigroup KeystrokeCfg where
<> :: KeystrokeCfg -> KeystrokeCfg -> KeystrokeCfg
(<>) KeystrokeCfg
t1 KeystrokeCfg
t2 = KeystrokeCfg :: Maybe Bool -> KeystrokeCfg
KeystrokeCfg {
_kscIgnoreChildren :: Maybe Bool
_kscIgnoreChildren = KeystrokeCfg -> Maybe Bool
_kscIgnoreChildren KeystrokeCfg
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> KeystrokeCfg -> Maybe Bool
_kscIgnoreChildren KeystrokeCfg
t1
}
instance Monoid KeystrokeCfg where
mempty :: KeystrokeCfg
mempty = KeystrokeCfg
forall a. Default a => a
def
instance CmbIgnoreChildrenEvts KeystrokeCfg where
ignoreChildrenEvts_ :: Bool -> KeystrokeCfg
ignoreChildrenEvts_ Bool
ignore = KeystrokeCfg
forall a. Default a => a
def {
_kscIgnoreChildren :: Maybe Bool
_kscIgnoreChildren = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ignore
}
data KeyStroke = KeyStroke {
KeyStroke -> Text
_kstKsText :: Text,
KeyStroke -> Bool
_kstKsC :: Bool,
KeyStroke -> Bool
_kstKsCtrl :: Bool,
KeyStroke -> Bool
_kstKsCmd :: Bool,
KeyStroke -> Bool
_kstKsAlt :: Bool,
KeyStroke -> Bool
_kstKsShift :: Bool,
KeyStroke -> Set KeyCode
_kstKsKeys :: Set KeyCode,
KeyStroke -> Set Text
_kstKsKeysText :: Set Text,
KeyStroke -> [Text]
_kstKsErrors :: [Text]
} deriving (KeyStroke -> KeyStroke -> Bool
(KeyStroke -> KeyStroke -> Bool)
-> (KeyStroke -> KeyStroke -> Bool) -> Eq KeyStroke
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyStroke -> KeyStroke -> Bool
$c/= :: KeyStroke -> KeyStroke -> Bool
== :: KeyStroke -> KeyStroke -> Bool
$c== :: KeyStroke -> KeyStroke -> Bool
Eq, Int -> KeyStroke -> ShowS
[KeyStroke] -> ShowS
KeyStroke -> String
(Int -> KeyStroke -> ShowS)
-> (KeyStroke -> String)
-> ([KeyStroke] -> ShowS)
-> Show KeyStroke
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyStroke] -> ShowS
$cshowList :: [KeyStroke] -> ShowS
show :: KeyStroke -> String
$cshow :: KeyStroke -> String
showsPrec :: Int -> KeyStroke -> ShowS
$cshowsPrec :: Int -> KeyStroke -> ShowS
Show)
instance Default KeyStroke where
def :: KeyStroke
def = KeyStroke :: Text
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Set KeyCode
-> Set Text
-> [Text]
-> KeyStroke
KeyStroke {
_kstKsText :: Text
_kstKsText = Text
"",
_kstKsC :: Bool
_kstKsC = Bool
False,
_kstKsCtrl :: Bool
_kstKsCtrl = Bool
False,
_kstKsCmd :: Bool
_kstKsCmd = Bool
False,
_kstKsAlt :: Bool
_kstKsAlt = Bool
False,
_kstKsShift :: Bool
_kstKsShift = Bool
False,
_kstKsKeys :: Set KeyCode
_kstKsKeys = Set KeyCode
forall a. Set a
Set.empty,
_kstKsKeysText :: Set Text
_kstKsKeysText = Set Text
forall a. Set a
Set.empty,
_kstKsErrors :: [Text]
_kstKsErrors = []
}
newtype KeyStrokeState e = KeyStrokeState {
KeyStrokeState e -> [(KeyStroke, e)]
_kssLatest :: [(KeyStroke, e)]
} deriving (KeyStrokeState e -> KeyStrokeState e -> Bool
(KeyStrokeState e -> KeyStrokeState e -> Bool)
-> (KeyStrokeState e -> KeyStrokeState e -> Bool)
-> Eq (KeyStrokeState e)
forall e. Eq e => KeyStrokeState e -> KeyStrokeState e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyStrokeState e -> KeyStrokeState e -> Bool
$c/= :: forall e. Eq e => KeyStrokeState e -> KeyStrokeState e -> Bool
== :: KeyStrokeState e -> KeyStrokeState e -> Bool
$c== :: forall e. Eq e => KeyStrokeState e -> KeyStrokeState e -> Bool
Eq, Int -> KeyStrokeState e -> ShowS
[KeyStrokeState e] -> ShowS
KeyStrokeState e -> String
(Int -> KeyStrokeState e -> ShowS)
-> (KeyStrokeState e -> String)
-> ([KeyStrokeState e] -> ShowS)
-> Show (KeyStrokeState e)
forall e. Show e => Int -> KeyStrokeState e -> ShowS
forall e. Show e => [KeyStrokeState e] -> ShowS
forall e. Show e => KeyStrokeState e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyStrokeState e] -> ShowS
$cshowList :: forall e. Show e => [KeyStrokeState e] -> ShowS
show :: KeyStrokeState e -> String
$cshow :: forall e. Show e => KeyStrokeState e -> String
showsPrec :: Int -> KeyStrokeState e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> KeyStrokeState e -> ShowS
Show)
data KeyEntry
= KeyEntryCode KeyCode
| KeyEntryText Text
deriving (KeyEntry -> KeyEntry -> Bool
(KeyEntry -> KeyEntry -> Bool)
-> (KeyEntry -> KeyEntry -> Bool) -> Eq KeyEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEntry -> KeyEntry -> Bool
$c/= :: KeyEntry -> KeyEntry -> Bool
== :: KeyEntry -> KeyEntry -> Bool
$c== :: KeyEntry -> KeyEntry -> Bool
Eq, Int -> KeyEntry -> ShowS
[KeyEntry] -> ShowS
KeyEntry -> String
(Int -> KeyEntry -> ShowS)
-> (KeyEntry -> String) -> ([KeyEntry] -> ShowS) -> Show KeyEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyEntry] -> ShowS
$cshowList :: [KeyEntry] -> ShowS
show :: KeyEntry -> String
$cshow :: KeyEntry -> String
showsPrec :: Int -> KeyEntry -> ShowS
$cshowsPrec :: Int -> KeyEntry -> ShowS
Show)
makeLensesWith abbreviatedFields ''KeyStroke
makeLensesWith abbreviatedFields ''KeyStrokeState
keystroke :: WidgetEvent e => [(Text, e)] -> WidgetNode s e -> WidgetNode s e
keystroke :: [(Text, e)] -> WidgetNode s e -> WidgetNode s e
keystroke [(Text, e)]
bindings WidgetNode s e
managed = [(Text, e)] -> [KeystrokeCfg] -> WidgetNode s e -> WidgetNode s e
forall e s.
WidgetEvent e =>
[(Text, e)] -> [KeystrokeCfg] -> WidgetNode s e -> WidgetNode s e
keystroke_ [(Text, e)]
bindings [KeystrokeCfg]
forall a. Default a => a
def WidgetNode s e
managed
keystroke_
:: WidgetEvent e
=> [(Text, e)]
-> [KeystrokeCfg]
-> WidgetNode s e
-> WidgetNode s e
keystroke_ :: [(Text, e)] -> [KeystrokeCfg] -> WidgetNode s e -> WidgetNode s e
keystroke_ [(Text, e)]
bindings [KeystrokeCfg]
configs WidgetNode s e
managed = Widget s e -> WidgetNode s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
forall s. Widget s e
widget WidgetNode s e
managed where
config :: KeystrokeCfg
config = [KeystrokeCfg] -> KeystrokeCfg
forall a. Monoid a => [a] -> a
mconcat [KeystrokeCfg]
configs
newBindings :: [(KeyStroke, e)]
newBindings = ((Text, e) -> (KeyStroke, e)) -> [(Text, e)] -> [(KeyStroke, e)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> KeyStroke) -> (Text, e) -> (KeyStroke, e)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> KeyStroke
textToStroke) [(Text, e)]
bindings
state :: KeyStrokeState e
state = [(KeyStroke, e)] -> KeyStrokeState e
forall e. [(KeyStroke, e)] -> KeyStrokeState e
KeyStrokeState []
widget :: Widget s e
widget = [(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
forall e s.
WidgetEvent e =>
[(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
makeKeystroke [(KeyStroke, e)]
newBindings KeystrokeCfg
config KeyStrokeState e
forall e. KeyStrokeState e
state
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"keystroke" Widget s e
widget
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e -> Seq (WidgetNode s e)
forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget
makeKeystroke
:: WidgetEvent e
=> [(KeyStroke, e)]
-> KeystrokeCfg
-> KeyStrokeState e
-> Widget s e
makeKeystroke :: [(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
makeKeystroke [(KeyStroke, e)]
bindings KeystrokeCfg
config KeyStrokeState e
state = Widget s e
forall s. Widget s e
widget where
widget :: Widget s e
widget = KeyStrokeState e -> Container s e (KeyStrokeState e) -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer KeyStrokeState e
state Container s e (KeyStrokeState e)
forall a. Default a => a
def {
containerMerge :: ContainerMergeHandler s e (KeyStrokeState e)
containerMerge = ContainerMergeHandler s e (KeyStrokeState e)
forall p s p.
p -> WidgetNode s e -> p -> KeyStrokeState e -> WidgetResult s e
merge,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall s e s p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent
}
merge :: p -> WidgetNode s e -> p -> KeyStrokeState e -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode KeyStrokeState e
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
forall e s.
WidgetEvent e =>
[(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
makeKeystroke [(KeyStroke, e)]
bindings KeystrokeCfg
config KeyStrokeState e
oldState
handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = KeyEntry -> Maybe (WidgetResult s e)
handleKeystroke (KeyCode -> KeyEntry
KeyEntryCode KeyCode
code)
TextInput Text
text
| Bool
ignoreChildren Bool -> Bool -> Bool
&& Text -> Bool
ignorePrevious Text
text -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
newState :: KeyStrokeState e
newState = [(KeyStroke, e)] -> KeyStrokeState e
forall e. [(KeyStroke, e)] -> KeyStrokeState e
KeyStrokeState []
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
forall e s.
WidgetEvent e =>
[(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
makeKeystroke [(KeyStroke, e)]
bindings KeystrokeCfg
config KeyStrokeState e
forall e. KeyStrokeState e
newState
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents]
TextInput Text
text
| Bool -> Bool
not (Text -> Bool
previousMatch Text
text) -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = KeyEntry -> Maybe (WidgetResult s e)
handleKeystroke (Text -> KeyEntry
KeyEntryText Text
text)
SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
ignoreChildren :: Bool
ignoreChildren = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== KeystrokeCfg -> Maybe Bool
_kscIgnoreChildren KeystrokeCfg
config
previousMatch :: Text -> Bool
previousMatch Text
t = Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` KeyStrokeState e -> [(KeyStroke, e)]
forall e. KeyStrokeState e -> [(KeyStroke, e)]
_kssLatest KeyStrokeState e
state [(KeyStroke, e)]
-> Getting (Endo [Text]) [(KeyStroke, e)] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((KeyStroke, e) -> Const (Endo [Text]) (KeyStroke, e))
-> [(KeyStroke, e)] -> Const (Endo [Text]) [(KeyStroke, e)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded (((KeyStroke, e) -> Const (Endo [Text]) (KeyStroke, e))
-> [(KeyStroke, e)] -> Const (Endo [Text]) [(KeyStroke, e)])
-> ((Text -> Const (Endo [Text]) Text)
-> (KeyStroke, e) -> Const (Endo [Text]) (KeyStroke, e))
-> Getting (Endo [Text]) [(KeyStroke, e)] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyStroke -> Const (Endo [Text]) KeyStroke)
-> (KeyStroke, e) -> Const (Endo [Text]) (KeyStroke, e)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((KeyStroke -> Const (Endo [Text]) KeyStroke)
-> (KeyStroke, e) -> Const (Endo [Text]) (KeyStroke, e))
-> ((Text -> Const (Endo [Text]) Text)
-> KeyStroke -> Const (Endo [Text]) KeyStroke)
-> (Text -> Const (Endo [Text]) Text)
-> (KeyStroke, e)
-> Const (Endo [Text]) (KeyStroke, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> KeyStroke -> Const (Endo [Text]) KeyStroke
forall s a. HasKsText s a => Lens' s a
ksText
ignorePrevious :: Text -> Bool
ignorePrevious Text
t = Text -> Bool
isTextValidCode Text
t Bool -> Bool -> Bool
&& Text -> Bool
previousMatch Text
t
handleKeystroke :: KeyEntry -> Maybe (WidgetResult s e)
handleKeystroke KeyEntry
entry = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
newWenv :: WidgetEnv s e
newWenv = WidgetEnv s e
wenv WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (InputStatus -> Identity InputStatus)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Identity InputStatus)
-> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (InputStatus -> InputStatus) -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ InputStatus -> InputStatus
removeMods
matches :: [(KeyStroke, e)]
matches = ((KeyStroke, e) -> Bool) -> [(KeyStroke, e)] -> [(KeyStroke, e)]
forall a. (a -> Bool) -> [a] -> [a]
filter (WidgetEnv s e -> KeyEntry -> KeyStroke -> Bool
forall s e. WidgetEnv s e -> KeyEntry -> KeyStroke -> Bool
keyStrokeActive WidgetEnv s e
newWenv KeyEntry
entry (KeyStroke -> Bool)
-> ((KeyStroke, e) -> KeyStroke) -> (KeyStroke, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyStroke, e) -> KeyStroke
forall a b. (a, b) -> a
fst) [(KeyStroke, e)]
bindings
newState :: KeyStrokeState e
newState = [(KeyStroke, e)] -> KeyStrokeState e
forall e. [(KeyStroke, e)] -> KeyStrokeState e
KeyStrokeState [(KeyStroke, e)]
matches
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
forall e s.
WidgetEvent e =>
[(KeyStroke, e)] -> KeystrokeCfg -> KeyStrokeState e -> Widget s e
makeKeystroke [(KeyStroke, e)]
bindings KeystrokeCfg
config KeyStrokeState e
newState
evts :: [e]
evts = (KeyStroke, e) -> e
forall a b. (a, b) -> b
snd ((KeyStroke, e) -> e) -> [(KeyStroke, e)] -> [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(KeyStroke, e)]
matches
reqs :: [WidgetRequest s e]
reqs
| Bool
ignoreChildren Bool -> Bool -> Bool
&& Bool -> Bool
not ([e] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [e]
evts) = [WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents]
| Bool
otherwise = []
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
forall e s.
Typeable e =>
WidgetNode s e -> [WidgetRequest s e] -> [e] -> WidgetResult s e
resultReqsEvts WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs [e]
evts
keyStrokeActive :: WidgetEnv s e -> KeyEntry -> KeyStroke -> Bool
keyStrokeActive :: WidgetEnv s e -> KeyEntry -> KeyStroke -> Bool
keyStrokeActive WidgetEnv s e
wenv KeyEntry
entry KeyStroke
ks = Bool
currValid Bool -> Bool -> Bool
&& Bool
allPressed Bool -> Bool -> Bool
&& Bool
validMods where
status :: InputStatus
status = WidgetEnv s e
wenv WidgetEnv s e
-> Getting InputStatus (WidgetEnv s e) InputStatus -> InputStatus
forall s a. s -> Getting a s a -> a
^. Getting InputStatus (WidgetEnv s e) InputStatus
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus
keyMod :: KeyMod
keyMod = InputStatus
status InputStatus -> Getting KeyMod InputStatus KeyMod -> KeyMod
forall s a. s -> Getting a s a -> a
^. Getting KeyMod InputStatus KeyMod
forall s a. HasKeyMod s a => Lens' s a
L.keyMod
pressedKeys :: Map KeyCode KeyStatus
pressedKeys = (KeyStatus -> Bool)
-> Map KeyCode KeyStatus -> Map KeyCode KeyStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed) (InputStatus
status InputStatus
-> Getting
(Map KeyCode KeyStatus) InputStatus (Map KeyCode KeyStatus)
-> Map KeyCode KeyStatus
forall s a. s -> Getting a s a -> a
^. Getting (Map KeyCode KeyStatus) InputStatus (Map KeyCode KeyStatus)
forall s a. HasKeys s a => Lens' s a
L.keys)
(Bool
currValid, Bool
allPressed, Bool
ignoreShift) = case KeyEntry
entry of
KeyEntryCode KeyCode
code -> (Bool
valid, Bool
pressed, Bool
False) where
valid :: Bool
valid = KeyCode
code KeyCode -> Set KeyCode -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (KeyStroke
ks KeyStroke
-> Getting (Set KeyCode) KeyStroke (Set KeyCode) -> Set KeyCode
forall s a. s -> Getting a s a -> a
^. Getting (Set KeyCode) KeyStroke (Set KeyCode)
forall s a. HasKsKeys s a => Lens' s a
ksKeys) Bool -> Bool -> Bool
|| KeyCode
code KeyCode -> [KeyCode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeyCode]
modKeys
pressed :: Bool
pressed = Map KeyCode KeyStatus -> Set KeyCode
forall k a. Map k a -> Set k
M.keysSet Map KeyCode KeyStatus
pressedKeys Set KeyCode -> Set KeyCode -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStroke
ks KeyStroke
-> Getting (Set KeyCode) KeyStroke (Set KeyCode) -> Set KeyCode
forall s a. s -> Getting a s a -> a
^. Getting (Set KeyCode) KeyStroke (Set KeyCode)
forall s a. HasKsKeys s a => Lens' s a
ksKeys
KeyEntryText Text
txt -> (Bool
valid, Bool
True, Bool
True) where
valid :: Bool
valid = Text
txt Text -> Set Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (KeyStroke
ks KeyStroke -> Getting (Set Text) KeyStroke (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) KeyStroke (Set Text)
forall s a. HasKsKeysText s a => Lens' s a
ksKeysText)
ctrlPressed :: Bool
ctrlPressed = KeyMod -> Bool
isCtrlPressed KeyMod
keyMod
cmdPressed :: Bool
cmdPressed = WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv Bool -> Bool -> Bool
&& KeyMod -> Bool
isGUIPressed KeyMod
keyMod
validC :: Bool
validC = Bool -> Bool
not (KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsC s a => Lens' s a
ksC) Bool -> Bool -> Bool
|| KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsC s a => Lens' s a
ksC Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Bool
ctrlPressed Bool -> Bool -> Bool
|| Bool
cmdPressed)
validCtrl :: Bool
validCtrl = KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsCtrl s a => Lens' s a
ksCtrl Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
ctrlPressed Bool -> Bool -> Bool
|| Bool
ctrlPressed Bool -> Bool -> Bool
&& Bool
validC
validCmd :: Bool
validCmd = KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsCmd s a => Lens' s a
ksCmd Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
cmdPressed Bool -> Bool -> Bool
|| Bool
cmdPressed Bool -> Bool -> Bool
&& Bool
validC
validShift :: Bool
validShift = KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsShift s a => Lens' s a
ksShift Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMod -> Bool
isShiftPressed KeyMod
keyMod Bool -> Bool -> Bool
|| Bool
ignoreShift
validAlt :: Bool
validAlt = KeyStroke
ks KeyStroke -> Getting Bool KeyStroke Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool KeyStroke Bool
forall s a. HasKsAlt s a => Lens' s a
ksAlt Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMod -> Bool
isAltPressed KeyMod
keyMod
validMods :: Bool
validMods = (Bool
validC Bool -> Bool -> Bool
&& Bool
validCtrl Bool -> Bool -> Bool
&& Bool
validCmd) Bool -> Bool -> Bool
&& Bool
validShift Bool -> Bool -> Bool
&& Bool
validAlt
textToStroke :: Text -> KeyStroke
textToStroke :: Text -> KeyStroke
textToStroke Text
text = KeyStroke
result where
parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') Text
text
ks :: KeyStroke
ks = (KeyStroke -> Text -> KeyStroke)
-> KeyStroke -> [Text] -> KeyStroke
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' KeyStroke -> Text -> KeyStroke
partToStroke KeyStroke
forall a. Default a => a
def [Text]
parts
KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsText s a => Lens' s a
ksText ((Text -> Identity Text) -> KeyStroke -> Identity KeyStroke)
-> Text -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
text
errors :: [Text]
errors = KeyStroke
ks KeyStroke -> Getting [Text] KeyStroke [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] KeyStroke [Text]
forall s a. HasKsErrors s a => Lens' s a
ksErrors
errorMsg :: Text
errorMsg = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is not valid. Invalid parts: "
result :: KeyStroke
result
| Bool -> Bool
not (Text -> Bool
T.null Text
text) Bool -> Bool -> Bool
&& [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
errors = KeyStroke
ks
| Bool
otherwise = (Text, [Text]) -> KeyStroke -> KeyStroke
forall a b. Show a => a -> b -> b
traceShow (Text
errorMsg, [Text]
errors) KeyStroke
ks
partToStroke :: KeyStroke -> Text -> KeyStroke
partToStroke :: KeyStroke -> Text -> KeyStroke
partToStroke KeyStroke
ks Text
"A" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsAlt s a => Lens' s a
ksAlt ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Alt" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsAlt s a => Lens' s a
ksAlt ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"C" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsC s a => Lens' s a
ksC ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Ctrl" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsCtrl s a => Lens' s a
ksCtrl ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Cmd" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsCmd s a => Lens' s a
ksCmd ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"O" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsAlt s a => Lens' s a
ksAlt ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Option" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsAlt s a => Lens' s a
ksAlt ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"S" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsShift s a => Lens' s a
ksShift ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Shift" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsShift s a => Lens' s a
ksShift ((Bool -> Identity Bool) -> KeyStroke -> Identity KeyStroke)
-> Bool -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
partToStroke KeyStroke
ks Text
"Backspace" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyBackspace
partToStroke KeyStroke
ks Text
"Caps" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyCapsLock
partToStroke KeyStroke
ks Text
"Delete" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyDelete
partToStroke KeyStroke
ks Text
"Enter" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyReturn
partToStroke KeyStroke
ks Text
"KpEnter" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyPadEnter
partToStroke KeyStroke
ks Text
"Esc" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyEscape
partToStroke KeyStroke
ks Text
"Return" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyReturn
partToStroke KeyStroke
ks Text
"Space" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keySpace
partToStroke KeyStroke
ks Text
"Tab" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyTab
partToStroke KeyStroke
ks Text
"Up" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyUp
partToStroke KeyStroke
ks Text
"Down" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyDown
partToStroke KeyStroke
ks Text
"Left" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyLeft
partToStroke KeyStroke
ks Text
"Right" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyRight
partToStroke KeyStroke
ks Text
"F1" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF1
partToStroke KeyStroke
ks Text
"F2" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF2
partToStroke KeyStroke
ks Text
"F3" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF3
partToStroke KeyStroke
ks Text
"F4" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF4
partToStroke KeyStroke
ks Text
"F5" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF5
partToStroke KeyStroke
ks Text
"F6" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF6
partToStroke KeyStroke
ks Text
"F7" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF7
partToStroke KeyStroke
ks Text
"F8" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF8
partToStroke KeyStroke
ks Text
"F9" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF9
partToStroke KeyStroke
ks Text
"F10" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF10
partToStroke KeyStroke
ks Text
"F11" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF11
partToStroke KeyStroke
ks Text
"F12" = KeyStroke
ks KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert KeyCode
keyF12
partToStroke KeyStroke
ks Text
"Dash" = KeyStroke -> Text -> KeyStroke
partToStroke KeyStroke
ks Text
"-"
partToStroke KeyStroke
ks Text
txt
| Text -> Bool
isTextValidCode Text
txt = KeyStroke
ks
KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeys s a => Lens' s a
ksKeys ((Set KeyCode -> Identity (Set KeyCode))
-> KeyStroke -> Identity KeyStroke)
-> (Set KeyCode -> Set KeyCode) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyCode -> Set KeyCode -> Set KeyCode
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> KeyCode
KeyCode (Char -> Int
ord Char
txtHead))
KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& (Set Text -> Identity (Set Text))
-> KeyStroke -> Identity KeyStroke
forall s a. HasKsKeysText s a => Lens' s a
ksKeysText ((Set Text -> Identity (Set Text))
-> KeyStroke -> Identity KeyStroke)
-> (Set Text -> Set Text) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
txt
| Bool
otherwise = KeyStroke
ks
KeyStroke -> (KeyStroke -> KeyStroke) -> KeyStroke
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> KeyStroke -> Identity KeyStroke
forall s a. HasKsErrors s a => Lens' s a
ksErrors (([Text] -> Identity [Text]) -> KeyStroke -> Identity KeyStroke)
-> ([Text] -> [Text]) -> KeyStroke -> KeyStroke
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
txt])
where
txtHead :: Char
txtHead = Text -> Int -> Char
T.index Text
txt Int
0
isTextValidCode :: Text -> Bool
isTextValidCode :: Text -> Bool
isTextValidCode Text
txt = Bool
validLen Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
txtHead Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
txtHead where
validLen :: Bool
validLen = Text -> Int
T.length Text
txt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
txtHead :: Char
txtHead = Text -> Int -> Char
T.index Text
txt Int
0
removeMods :: InputStatus -> InputStatus
removeMods :: InputStatus -> InputStatus
removeMods InputStatus
status = InputStatus
status
InputStatus -> (InputStatus -> InputStatus) -> InputStatus
forall a b. a -> (a -> b) -> b
& (Map KeyCode KeyStatus -> Identity (Map KeyCode KeyStatus))
-> InputStatus -> Identity InputStatus
forall s a. HasKeys s a => Lens' s a
L.keys ((Map KeyCode KeyStatus -> Identity (Map KeyCode KeyStatus))
-> InputStatus -> Identity InputStatus)
-> (Map KeyCode KeyStatus -> Map KeyCode KeyStatus)
-> InputStatus
-> InputStatus
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (KeyCode -> KeyStatus -> Bool)
-> Map KeyCode KeyStatus -> Map KeyCode KeyStatus
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\KeyCode
k KeyStatus
v -> KeyCode
k KeyCode -> [KeyCode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [KeyCode]
modKeys)
modKeys :: [KeyCode]
modKeys :: [KeyCode]
modKeys = [
KeyCode
keyLAlt, KeyCode
keyRAlt, KeyCode
keyLCtrl, KeyCode
keyRCtrl, KeyCode
keyLGUI, KeyCode
keyRGUI, KeyCode
keyLShift, KeyCode
keyRShift
]