diff options
Diffstat (limited to 'src/Internal/KeysM.hs')
| -rw-r--r-- | src/Internal/KeysM.hs | 179 |
1 files changed, 101 insertions, 78 deletions
diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs index f834796..b394552 100644 --- a/src/Internal/KeysM.hs +++ b/src/Internal/KeysM.hs @@ -9,11 +9,17 @@ import XMonad import Data.Map (Map) import qualified Data.Map as Map +data KeyBinding = Action (X ()) | Submap KeyBindings +type KeyBindings = Map (KeyMask, KeySym) KeyBinding + +type ButtonBinding = Window -> X () +type ButtonBindings = Map (KeyMask, Button) ButtonBinding + {- Module that defines a DSL for binding keys. -} -newtype KeysM l a = KeysM (State (XConfig l, Map (KeyMask, KeySym) (X ())) a) +newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a) deriving (Functor, Applicative, Monad) -newtype ButtonsM l a = ButtonsM (State (XConfig l, Map (KeyMask, Button) (Window -> X ())) a) +newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a) deriving (Functor, Applicative, Monad) newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a) @@ -28,11 +34,30 @@ class Bindable k where bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l () -runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ()) +class Binding k b where + rawMask :: KeyMask -> k -> BindingBuilder b () + +instance Binding (X ()) KeyBinding where + rawMask m x = BindingBuilder $ modify' (second ((m, Action x):)) + +instance Binding KeyBindings KeyBinding where + rawMask m x = BindingBuilder $ modify' (second ((m, Submap x):)) + +instance Binding a a where + rawMask m x = BindingBuilder $ modify' (second ((m, x):)) + +instance Semigroup (KeysM l ()) where + (<>) = mappend + +instance Monoid (KeysM l ()) where + mempty = return () + mappend = (>>) + +runKeys :: KeysM l a -> XConfig l -> KeyBindings runKeys (KeysM stateM) config = snd $ execState stateM (config, Map.empty) -runButtons :: ButtonsM l a -> XConfig l -> Map (KeyMask, Button) (Window -> X ()) +runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings runButtons (ButtonsM stateM) config = snd $ execState stateM (config, Map.empty) @@ -43,13 +68,10 @@ instance HasConfig ButtonsM where getConfig = fst <$> ButtonsM get {- Generally it is assumed that the mod key shoud be pressed, but not always. -} -noMod :: f -> BindingBuilder f () +noMod :: (Binding k b) => k -> BindingBuilder b () noMod = rawMask 0 -rawMask :: KeyMask -> f -> BindingBuilder f () -rawMask m x = BindingBuilder $ modify' (second ((m, x):)) - -maskMod :: KeyMask -> f -> BindingBuilder f () +maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b () maskMod mask action = do modMask <- fst <$> BindingBuilder get rawMask (modMask .|. mask) action @@ -66,11 +88,11 @@ altgrMask = mod2Mask superMask :: KeyMask superMask = mod4Mask -justMod :: f -> BindingBuilder f () +justMod :: (Binding k b) => k -> BindingBuilder b () justMod = maskMod 0 instance Bindable KeySym where - type BindableValue KeySym = X () + type BindableValue KeySym = KeyBinding type BindableMonad KeySym = KeysM -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l () @@ -82,7 +104,7 @@ instance Bindable KeySym where flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values)) instance Bindable Button where - type BindableValue Button = Window -> X () + type BindableValue Button = ButtonBinding type BindableMonad Button = ButtonsM -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l () @@ -93,257 +115,258 @@ instance Bindable Button where ButtonsM $ modify' $ second $ flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values)) -shiftControlAltSuperHyperAltgrMod :: f -> BindingBuilder f () +shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltSuperHyperAltgrMod = maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask) -shiftControlAltSuperHyperMod :: f -> BindingBuilder f () +shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltSuperHyperMod = maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask) -shiftControlAltSuperAltgrMod :: f -> BindingBuilder f () +shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltSuperAltgrMod = maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask) -shiftControlAltSuperMod :: f -> BindingBuilder f () +shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltSuperMod = maskMod (shiftMask .|. controlMask .|. altMask .|. superMask) -shiftControlAltHyperAltgrMod :: f -> BindingBuilder f () +shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltHyperAltgrMod = maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask) -shiftControlAltHyperMod :: f -> BindingBuilder f () +shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltHyperMod = maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask) -shiftControlAltAltgrMod :: f -> BindingBuilder f () +shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltAltgrMod = maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask) -shiftControlAltMod :: f -> BindingBuilder f () +shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltMod = maskMod (shiftMask .|. controlMask .|. altMask) -shiftControlSuperHyperAltgrMod :: f -> BindingBuilder f () +shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlSuperHyperAltgrMod = maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask) -shiftControlSuperHyperMod :: f -> BindingBuilder f () +shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlSuperHyperMod = maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask) -shiftControlSuperAltgrMod :: f -> BindingBuilder f () +shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlSuperAltgrMod = maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask) -shiftControlSuperMod :: f -> BindingBuilder f () +shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlSuperMod = maskMod (shiftMask .|. controlMask .|. superMask) -shiftControlHyperAltgrMod :: f -> BindingBuilder f () +shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlHyperAltgrMod = maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask) -shiftControlHyperMod :: f -> BindingBuilder f () +shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftControlHyperMod = maskMod (shiftMask .|. controlMask .|. hyperMask) -shiftControlAltgrMod :: f -> BindingBuilder f () +shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltgrMod = maskMod (shiftMask .|. controlMask .|. altgrMask) -shiftControlMod :: f -> BindingBuilder f () +shiftControlMod :: (Binding k b) => k -> BindingBuilder b () shiftControlMod = maskMod (shiftMask .|. controlMask) -shiftAltSuperHyperAltgrMod :: f -> BindingBuilder f () +shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftAltSuperHyperAltgrMod = maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask) -shiftAltSuperHyperMod :: f -> BindingBuilder f () +shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftAltSuperHyperMod = maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask) -shiftAltSuperAltgrMod :: f -> BindingBuilder f () +shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftAltSuperAltgrMod = maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask) -shiftAltSuperMod :: f -> BindingBuilder f () +shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b () shiftAltSuperMod = maskMod (shiftMask .|. altMask .|. superMask) -shiftAltHyperAltgrMod :: f -> BindingBuilder f () +shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftAltHyperAltgrMod = maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask) -shiftAltHyperMod :: f -> BindingBuilder f () +shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftAltHyperMod = maskMod (shiftMask .|. altMask .|. hyperMask) -shiftAltAltgrMod :: f -> BindingBuilder f () +shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftAltAltgrMod = maskMod (shiftMask .|. altMask .|. altgrMask) -shiftAltMod :: f -> BindingBuilder f () +shiftAltMod :: (Binding k b) => k -> BindingBuilder b () shiftAltMod = maskMod (shiftMask .|. altMask) -shiftSuperHyperAltgrMod :: f -> BindingBuilder f () +shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftSuperHyperAltgrMod = maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask) -shiftSuperHyperMod :: f -> BindingBuilder f () +shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftSuperHyperMod = maskMod (shiftMask .|. superMask .|. hyperMask) -shiftSuperAltgrMod :: f -> BindingBuilder f () +shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftSuperAltgrMod = maskMod (shiftMask .|. superMask .|. altgrMask) -shiftSuperMod :: f -> BindingBuilder f () +shiftSuperMod :: (Binding k b) => k -> BindingBuilder b () shiftSuperMod = maskMod (shiftMask .|. superMask) -shiftHyperAltgrMod :: f -> BindingBuilder f () +shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftHyperAltgrMod = maskMod (shiftMask .|. hyperMask .|. altgrMask) -shiftHyperMod :: f -> BindingBuilder f () +shiftHyperMod :: (Binding k b) => k -> BindingBuilder b () shiftHyperMod = maskMod (shiftMask .|. hyperMask) -shiftAltgrMod :: f -> BindingBuilder f () +shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftAltgrMod = maskMod (shiftMask .|. altgrMask) -shiftMod :: f -> BindingBuilder f () +shiftMod :: (Binding k b) => k -> BindingBuilder b () shiftMod = maskMod shiftMask -controlAltSuperHyperAltgrMod :: f -> BindingBuilder f () +controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlAltSuperHyperAltgrMod = maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask) -controlAltSuperHyperMod :: f -> BindingBuilder f () +controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () controlAltSuperHyperMod = maskMod (controlMask .|. altMask .|. superMask .|. hyperMask) -controlAltSuperAltgrMod :: f -> BindingBuilder f () +controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlAltSuperAltgrMod = maskMod (controlMask .|. altMask .|. superMask .|. altgrMask) -controlAltSuperMod :: f -> BindingBuilder f () +controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b () controlAltSuperMod = maskMod (controlMask .|. altMask .|. superMask) -controlAltHyperAltgrMod :: f -> BindingBuilder f () +controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlAltHyperAltgrMod = maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask) -controlAltHyperMod :: f -> BindingBuilder f () +controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b () controlAltHyperMod = maskMod (controlMask .|. altMask .|. hyperMask) -controlAltAltgrMod :: f -> BindingBuilder f () +controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlAltAltgrMod = maskMod (controlMask .|. altMask .|. altgrMask) -controlAltMod :: f -> BindingBuilder f () +controlAltMod :: (Binding k b) => k -> BindingBuilder b () controlAltMod = maskMod (controlMask .|. altMask) -controlSuperHyperAltgrMod :: f -> BindingBuilder f () +controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlSuperHyperAltgrMod = maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask) -controlSuperHyperMod :: f -> BindingBuilder f () +controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () controlSuperHyperMod = maskMod (controlMask .|. superMask .|. hyperMask) -controlSuperAltgrMod :: f -> BindingBuilder f () +controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlSuperAltgrMod = maskMod (controlMask .|. superMask .|. altgrMask) -controlSuperMod :: f -> BindingBuilder f () +controlSuperMod :: (Binding k b) => k -> BindingBuilder b () controlSuperMod = maskMod (controlMask .|. superMask) -controlHyperAltgrMod :: f -> BindingBuilder f () +controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlHyperAltgrMod = maskMod (controlMask .|. hyperMask .|. altgrMask) -controlHyperMod :: f -> BindingBuilder f () +controlHyperMod :: (Binding k b) => k -> BindingBuilder b () controlHyperMod = maskMod (controlMask .|. hyperMask) -controlAltgrMod :: f -> BindingBuilder f () +controlAltgrMod :: (Binding k b) => k -> BindingBuilder b () controlAltgrMod = maskMod (controlMask .|. altgrMask) -controlMod :: f -> BindingBuilder f () +controlMod :: (Binding k b) => k -> BindingBuilder b () controlMod = maskMod controlMask -altSuperHyperAltgrMod :: f -> BindingBuilder f () +altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () altSuperHyperAltgrMod = maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask) -altSuperHyperMod :: f -> BindingBuilder f () +altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b () altSuperHyperMod = maskMod (altMask .|. superMask .|. hyperMask) -altSuperAltgrMod :: f -> BindingBuilder f () +altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b () altSuperAltgrMod = maskMod (altMask .|. superMask .|. altgrMask) -altSuperMod :: f -> BindingBuilder f () +altSuperMod :: (Binding k b) => k -> BindingBuilder b () altSuperMod = maskMod (altMask .|. superMask) -altHyperAltgrMod :: f -> BindingBuilder f () +altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () altHyperAltgrMod = maskMod (altMask .|. hyperMask .|. altgrMask) -altHyperMod :: f -> BindingBuilder f () +altHyperMod :: (Binding k b) => k -> BindingBuilder b () altHyperMod = maskMod (altMask .|. hyperMask) -altAltgrMod :: f -> BindingBuilder f () +altAltgrMod :: (Binding k b) => k -> BindingBuilder b () altAltgrMod = maskMod (altMask .|. altgrMask) -altMod :: f -> BindingBuilder f () +altMod :: (Binding k b) => k -> BindingBuilder b () altMod = maskMod altMask -superHyperAltgrMod :: f -> BindingBuilder f () +superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () superHyperAltgrMod = maskMod (superMask .|. hyperMask .|. altgrMask) -superHyperMod :: f -> BindingBuilder f () +superHyperMod :: (Binding k b) => k -> BindingBuilder b () superHyperMod = maskMod (superMask .|. hyperMask) -superAltgrMod :: f -> BindingBuilder f () +superAltgrMod :: (Binding k b) => k -> BindingBuilder b () superAltgrMod = maskMod (superMask .|. altgrMask) -superMod :: f -> BindingBuilder f () +superMod :: (Binding k b) => k -> BindingBuilder b () superMod = maskMod superMask -hyperAltgrMod :: f -> BindingBuilder f () +hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () hyperAltgrMod = maskMod (hyperMask .|. altgrMask) -hyperMod :: f -> BindingBuilder f () +hyperMod :: (Binding k b) => k -> BindingBuilder b () hyperMod = maskMod hyperMask -altgrMod :: f -> BindingBuilder f () +altgrMod :: (Binding k b) => k -> BindingBuilder b () altgrMod = maskMod altgrMask {- Can combine two or more of the functions above to apply the same action to - multiple masks. -} -(-|-) :: (f -> BindingBuilder f ()) -> - (f -> BindingBuilder f ()) -> - f -> BindingBuilder f () +(-|-) :: (Binding k b) => + (k -> BindingBuilder b ()) -> + (k -> BindingBuilder b ()) -> + k -> BindingBuilder b () (-|-) fn1 fn2 f = fn1 f >> fn2 f {- Meant for submapping, binds all alphanumeric charactes to (fn c). -} |