From e6b50c5dd6f6d9411846ace54a2a5a8b3b56dae7 Mon Sep 17 00:00:00 2001 From: slotThe Date: Sat, 5 Feb 2022 10:32:40 +0100 Subject: [PATCH 1/3] X.Prelude: Concat modifier keys instead of unwording Instead of printing "M- S- C-", print "M-S-C". --- XMonad/Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs index 227211d1..ba10f772 100644 --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -91,7 +91,7 @@ keymaskToString :: KeyMask -- ^ Num lock mask -> KeyMask -- ^ Modifier mask -> String keymaskToString numLockMask msk = - unwords . reverse . fst . foldr go ([], msk) $ masks + concat . reverse . fst . foldr go ([], msk) $ masks where masks :: [(KeyMask, String)] masks = map (\m -> (m, show m)) From 7d91a1bf855ead8a77bdf039f59d0d0eb6420169 Mon Sep 17 00:00:00 2001 From: slotThe Date: Sat, 5 Feb 2022 10:34:22 +0100 Subject: [PATCH 2/3] X.Prelude: Improve keyToString output MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The keysymToString function prints the key names in pure ASCII; e.g., `keysymToString 250` returns "uacute" instead of "ú". This is undesirable when printing these keysyms in places like visualSubmap. Thus, move all of the key infrastructure (heh) from X.U.EZConfig to X.Prelude and look up the name of the key if possible. For better composability, slightly change the signature for `regularKeys` and the associated parser. --- XMonad/Prelude.hs | 287 +++++++++++++++++++++++++++++++++++++++- XMonad/Util/EZConfig.hs | 258 +----------------------------------- 2 files changed, 287 insertions(+), 258 deletions(-) diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs index ba10f772..18805fa2 100644 --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -22,9 +22,16 @@ module XMonad.Prelude ( NonEmpty((:|)), notEmpty, safeGetWindowAttributes, + + -- * Keys keyToString, keymaskToString, cleanKeyMask, + regularKeys, + allSpecialKeys, + specialKeys, + multimediaKeys, + functionKeys, ) where import Foreign (alloca, peek) @@ -42,9 +49,13 @@ import Data.Maybe as Exports import Data.Monoid as Exports import Data.Traversable as Exports +import qualified Data.Map.Strict as Map + +import Control.Arrow ((&&&), first) import Data.Bifunctor (bimap) import Data.Bits import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Tuple (swap) import GHC.Stack -- | Short for 'fromIntegral'. @@ -86,6 +97,9 @@ safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p -> 0 -> pure Nothing _ -> Just <$> peek p +----------------------------------------------------------------------- +-- Keys + -- | Convert a modifier mask into a useful string. keymaskToString :: KeyMask -- ^ Num lock mask -> KeyMask -- ^ Modifier mask @@ -115,8 +129,18 @@ keymaskToString numLockMask msk = -- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym' -- pair, into a string. -keyToString :: (KeyMask, KeySym) -> [Char] -keyToString = uncurry (++) . bimap (keymaskToString 0) keysymToString +keyToString :: (KeyMask, KeySym) -> String +keyToString = uncurry (++) . bimap (keymaskToString 0) ppKeysym + where + ppKeysym :: KeySym -> String + ppKeysym x = case specialMap Map.!? x of + Just s -> "<" <> s <> ">" + Nothing -> case regularMap Map.!? x of + Nothing -> keysymToString x + Just s -> s + + regularMap = Map.fromList (map swap regularKeys) + specialMap = Map.fromList (map swap allSpecialKeys) -- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask', -- leaving only modifier keys like Shift, Control, Super, Hyper in the mask @@ -132,3 +156,262 @@ cleanKeyMask = cleanKeyMask' <$> gets numberlockMask cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask cleanKeyMask' numLockMask mask = mask .&. complement (numLockMask .|. lockMask) .&. (button1Mask - 1) + +-- | A list of "regular" (extended ASCII) keys. +regularKeys :: [(String, KeySym)] +regularKeys = map (first (:[])) + $ zip ['!' .. '~' ] -- ASCII + [xK_exclam .. xK_asciitilde] + <> zip ['\xa0' .. '\xff' ] -- Latin1 + [xK_nobreakspace .. xK_ydiaeresis] + +-- | A list of all special key names and their associated KeySyms. +allSpecialKeys :: [(String, KeySym)] +allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys + +-- | A list pairing function key descriptor strings (e.g. @\"\"@) +-- with the associated KeySyms. +functionKeys :: [(String, KeySym)] +functionKeys = [ ('F' : show n, k) + | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] + ] + +-- | A list of special key names and their corresponding KeySyms. +specialKeys :: [(String, KeySym)] +specialKeys = + [ ("Backspace" , xK_BackSpace) + , ("Tab" , xK_Tab) + , ("Return" , xK_Return) + , ("Pause" , xK_Pause) + , ("Num_Lock" , xK_Num_Lock) + , ("Caps_Lock" , xK_Caps_Lock) + , ("Scroll_lock", xK_Scroll_Lock) + , ("Sys_Req" , xK_Sys_Req) + , ("Print" , xK_Print) + , ("Escape" , xK_Escape) + , ("Esc" , xK_Escape) + , ("Delete" , xK_Delete) + , ("Home" , xK_Home) + , ("Left" , xK_Left) + , ("Up" , xK_Up) + , ("Right" , xK_Right) + , ("Down" , xK_Down) + , ("L" , xK_Left) + , ("U" , xK_Up) + , ("R" , xK_Right) + , ("D" , xK_Down) + , ("Page_Up" , xK_Page_Up) + , ("Page_Down" , xK_Page_Down) + , ("End" , xK_End) + , ("Insert" , xK_Insert) + , ("Break" , xK_Break) + , ("Space" , xK_space) + , ("Control_L" , xK_Control_L) + , ("Control_R" , xK_Control_R) + , ("Shift_L" , xK_Shift_L) + , ("Shift_R" , xK_Shift_R) + , ("Alt_L" , xK_Alt_L) + , ("Alt_R" , xK_Alt_R) + , ("Meta_L" , xK_Meta_L) + , ("Meta_R" , xK_Meta_R) + , ("Super_L" , xK_Super_L) + , ("Super_R" , xK_Super_R) + , ("Hyper_L" , xK_Hyper_L) + , ("Hyper_R" , xK_Hyper_R) + , ("KP_Space" , xK_KP_Space) + , ("KP_Tab" , xK_KP_Tab) + , ("KP_Enter" , xK_KP_Enter) + , ("KP_F1" , xK_KP_F1) + , ("KP_F2" , xK_KP_F2) + , ("KP_F3" , xK_KP_F3) + , ("KP_F4" , xK_KP_F4) + , ("KP_Home" , xK_KP_Home) + , ("KP_Left" , xK_KP_Left) + , ("KP_Up" , xK_KP_Up) + , ("KP_Right" , xK_KP_Right) + , ("KP_Down" , xK_KP_Down) + , ("KP_Prior" , xK_KP_Prior) + , ("KP_Page_Up" , xK_KP_Page_Up) + , ("KP_Next" , xK_KP_Next) + , ("KP_Page_Down", xK_KP_Page_Down) + , ("KP_End" , xK_KP_End) + , ("KP_Begin" , xK_KP_Begin) + , ("KP_Insert" , xK_KP_Insert) + , ("KP_Delete" , xK_KP_Delete) + , ("KP_Equal" , xK_KP_Equal) + , ("KP_Multiply", xK_KP_Multiply) + , ("KP_Add" , xK_KP_Add) + , ("KP_Separator", xK_KP_Separator) + , ("KP_Subtract", xK_KP_Subtract) + , ("KP_Decimal" , xK_KP_Decimal) + , ("KP_Divide" , xK_KP_Divide) + , ("KP_0" , xK_KP_0) + , ("KP_1" , xK_KP_1) + , ("KP_2" , xK_KP_2) + , ("KP_3" , xK_KP_3) + , ("KP_4" , xK_KP_4) + , ("KP_5" , xK_KP_5) + , ("KP_6" , xK_KP_6) + , ("KP_7" , xK_KP_7) + , ("KP_8" , xK_KP_8) + , ("KP_9" , xK_KP_9) + ] + +-- | List of multimedia keys. If Xlib does not know about some keysym +-- it's omitted from the list ('stringToKeysym' returns 'noSymbol' in +-- this case). +multimediaKeys :: [(String, KeySym)] +multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ + [ "XF86ModeLock" + , "XF86MonBrightnessUp" + , "XF86MonBrightnessDown" + , "XF86KbdLightOnOff" + , "XF86KbdBrightnessUp" + , "XF86KbdBrightnessDown" + , "XF86Standby" + , "XF86AudioLowerVolume" + , "XF86AudioMute" + , "XF86AudioRaiseVolume" + , "XF86AudioPlay" + , "XF86AudioStop" + , "XF86AudioPrev" + , "XF86AudioNext" + , "XF86HomePage" + , "XF86Mail" + , "XF86Start" + , "XF86Search" + , "XF86AudioRecord" + , "XF86Calculator" + , "XF86Memo" + , "XF86ToDoList" + , "XF86Calendar" + , "XF86PowerDown" + , "XF86ContrastAdjust" + , "XF86RockerUp" + , "XF86RockerDown" + , "XF86RockerEnter" + , "XF86Back" + , "XF86Forward" + , "XF86Stop" + , "XF86Refresh" + , "XF86PowerOff" + , "XF86WakeUp" + , "XF86Eject" + , "XF86ScreenSaver" + , "XF86WWW" + , "XF86Sleep" + , "XF86Favorites" + , "XF86AudioPause" + , "XF86AudioMedia" + , "XF86MyComputer" + , "XF86VendorHome" + , "XF86LightBulb" + , "XF86Shop" + , "XF86History" + , "XF86OpenURL" + , "XF86AddFavorite" + , "XF86HotLinks" + , "XF86BrightnessAdjust" + , "XF86Finance" + , "XF86Community" + , "XF86AudioRewind" + , "XF86BackForward" + , "XF86Launch0" + , "XF86Launch1" + , "XF86Launch2" + , "XF86Launch3" + , "XF86Launch4" + , "XF86Launch5" + , "XF86Launch6" + , "XF86Launch7" + , "XF86Launch8" + , "XF86Launch9" + , "XF86LaunchA" + , "XF86LaunchB" + , "XF86LaunchC" + , "XF86LaunchD" + , "XF86LaunchE" + , "XF86LaunchF" + , "XF86ApplicationLeft" + , "XF86ApplicationRight" + , "XF86Book" + , "XF86CD" + , "XF86Calculater" + , "XF86Clear" + , "XF86Close" + , "XF86Copy" + , "XF86Cut" + , "XF86Display" + , "XF86DOS" + , "XF86Documents" + , "XF86Excel" + , "XF86Explorer" + , "XF86Game" + , "XF86Go" + , "XF86iTouch" + , "XF86LogOff" + , "XF86Market" + , "XF86Meeting" + , "XF86MenuKB" + , "XF86MenuPB" + , "XF86MySites" + , "XF86New" + , "XF86News" + , "XF86OfficeHome" + , "XF86Open" + , "XF86Option" + , "XF86Paste" + , "XF86Phone" + , "XF86Q" + , "XF86Reply" + , "XF86Reload" + , "XF86RotateWindows" + , "XF86RotationPB" + , "XF86RotationKB" + , "XF86Save" + , "XF86ScrollUp" + , "XF86ScrollDown" + , "XF86ScrollClick" + , "XF86Send" + , "XF86Spell" + , "XF86SplitScreen" + , "XF86Support" + , "XF86TaskPane" + , "XF86Terminal" + , "XF86Tools" + , "XF86Travel" + , "XF86UserPB" + , "XF86User1KB" + , "XF86User2KB" + , "XF86Video" + , "XF86WheelButton" + , "XF86Word" + , "XF86Xfer" + , "XF86ZoomIn" + , "XF86ZoomOut" + , "XF86Away" + , "XF86Messenger" + , "XF86WebCam" + , "XF86MailForward" + , "XF86Pictures" + , "XF86Music" + , "XF86TouchpadToggle" + , "XF86AudioMicMute" + , "XF86_Switch_VT_1" + , "XF86_Switch_VT_2" + , "XF86_Switch_VT_3" + , "XF86_Switch_VT_4" + , "XF86_Switch_VT_5" + , "XF86_Switch_VT_6" + , "XF86_Switch_VT_7" + , "XF86_Switch_VT_8" + , "XF86_Switch_VT_9" + , "XF86_Switch_VT_10" + , "XF86_Switch_VT_11" + , "XF86_Switch_VT_12" + , "XF86_Ungrab" + , "XF86_ClearGrab" + , "XF86_Next_VMode" + , "XF86_Prev_VMode" + , "XF86Bluetooth" + ] diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 71e54f09..3fd76be7 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -37,7 +37,6 @@ module XMonad.Util.EZConfig ( parseKeyCombo, parseKeySequence, readKeySequence, #ifdef TESTING - functionKeys, specialKeys, multimediaKeys, parseModifier, #endif ) where @@ -444,268 +443,15 @@ parseKey = parseSpecial <> parseRegular -- | Parse a regular key name (represented by itself). parseRegular :: Parser KeySym -parseRegular = choice [ char s $> k - | (s,k) <- zip ['!' .. '~' ] -- ASCII - [xK_exclam .. xK_asciitilde] - - ++ zip ['\xa0' .. '\xff' ] -- Latin1 - [xK_nobreakspace .. xK_ydiaeresis] - ] +parseRegular = choice [ string s $> k | (s, k) <- regularKeys ] -- | Parse a special key name (one enclosed in angle brackets). parseSpecial :: Parser KeySym parseSpecial = do _ <- char '<' choice [ k <$ string name <* char '>' - | (name, k) <- keyNames + | (name, k) <- allSpecialKeys ] --- | A list of all special key names and their associated KeySyms. -keyNames :: [(String, KeySym)] -keyNames = functionKeys ++ specialKeys ++ multimediaKeys - --- | A list pairing function key descriptor strings (e.g. @\"\"@) with --- the associated KeySyms. -functionKeys :: [(String, KeySym)] -functionKeys = [ ('F' : show n, k) - | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ] - --- | A list of special key names and their corresponding KeySyms. -specialKeys :: [(String, KeySym)] -specialKeys = [ ("Backspace" , xK_BackSpace) - , ("Tab" , xK_Tab) - , ("Return" , xK_Return) - , ("Pause" , xK_Pause) - , ("Num_Lock" , xK_Num_Lock) - , ("Caps_Lock" , xK_Caps_Lock) - , ("Scroll_lock", xK_Scroll_Lock) - , ("Sys_Req" , xK_Sys_Req) - , ("Print" , xK_Print) - , ("Escape" , xK_Escape) - , ("Esc" , xK_Escape) - , ("Delete" , xK_Delete) - , ("Home" , xK_Home) - , ("Left" , xK_Left) - , ("Up" , xK_Up) - , ("Right" , xK_Right) - , ("Down" , xK_Down) - , ("L" , xK_Left) - , ("U" , xK_Up) - , ("R" , xK_Right) - , ("D" , xK_Down) - , ("Page_Up" , xK_Page_Up) - , ("Page_Down" , xK_Page_Down) - , ("End" , xK_End) - , ("Insert" , xK_Insert) - , ("Break" , xK_Break) - , ("Space" , xK_space) - , ("Control_L" , xK_Control_L) - , ("Control_R" , xK_Control_R) - , ("Shift_L" , xK_Shift_L) - , ("Shift_R" , xK_Shift_R) - , ("Alt_L" , xK_Alt_L) - , ("Alt_R" , xK_Alt_R) - , ("Meta_L" , xK_Meta_L) - , ("Meta_R" , xK_Meta_R) - , ("Super_L" , xK_Super_L) - , ("Super_R" , xK_Super_R) - , ("Hyper_L" , xK_Hyper_L) - , ("Hyper_R" , xK_Hyper_R) - , ("KP_Space" , xK_KP_Space) - , ("KP_Tab" , xK_KP_Tab) - , ("KP_Enter" , xK_KP_Enter) - , ("KP_F1" , xK_KP_F1) - , ("KP_F2" , xK_KP_F2) - , ("KP_F3" , xK_KP_F3) - , ("KP_F4" , xK_KP_F4) - , ("KP_Home" , xK_KP_Home) - , ("KP_Left" , xK_KP_Left) - , ("KP_Up" , xK_KP_Up) - , ("KP_Right" , xK_KP_Right) - , ("KP_Down" , xK_KP_Down) - , ("KP_Prior" , xK_KP_Prior) - , ("KP_Page_Up" , xK_KP_Page_Up) - , ("KP_Next" , xK_KP_Next) - , ("KP_Page_Down", xK_KP_Page_Down) - , ("KP_End" , xK_KP_End) - , ("KP_Begin" , xK_KP_Begin) - , ("KP_Insert" , xK_KP_Insert) - , ("KP_Delete" , xK_KP_Delete) - , ("KP_Equal" , xK_KP_Equal) - , ("KP_Multiply", xK_KP_Multiply) - , ("KP_Add" , xK_KP_Add) - , ("KP_Separator", xK_KP_Separator) - , ("KP_Subtract", xK_KP_Subtract) - , ("KP_Decimal" , xK_KP_Decimal) - , ("KP_Divide" , xK_KP_Divide) - , ("KP_0" , xK_KP_0) - , ("KP_1" , xK_KP_1) - , ("KP_2" , xK_KP_2) - , ("KP_3" , xK_KP_3) - , ("KP_4" , xK_KP_4) - , ("KP_5" , xK_KP_5) - , ("KP_6" , xK_KP_6) - , ("KP_7" , xK_KP_7) - , ("KP_8" , xK_KP_8) - , ("KP_9" , xK_KP_9) - ] - --- | List of multimedia keys. If X server does not know about some --- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case) -multimediaKeys :: [(String, KeySym)] -multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ - [ "XF86ModeLock" - , "XF86MonBrightnessUp" - , "XF86MonBrightnessDown" - , "XF86KbdLightOnOff" - , "XF86KbdBrightnessUp" - , "XF86KbdBrightnessDown" - , "XF86Standby" - , "XF86AudioLowerVolume" - , "XF86AudioMute" - , "XF86AudioRaiseVolume" - , "XF86AudioPlay" - , "XF86AudioStop" - , "XF86AudioPrev" - , "XF86AudioNext" - , "XF86HomePage" - , "XF86Mail" - , "XF86Start" - , "XF86Search" - , "XF86AudioRecord" - , "XF86Calculator" - , "XF86Memo" - , "XF86ToDoList" - , "XF86Calendar" - , "XF86PowerDown" - , "XF86ContrastAdjust" - , "XF86RockerUp" - , "XF86RockerDown" - , "XF86RockerEnter" - , "XF86Back" - , "XF86Forward" - , "XF86Stop" - , "XF86Refresh" - , "XF86PowerOff" - , "XF86WakeUp" - , "XF86Eject" - , "XF86ScreenSaver" - , "XF86WWW" - , "XF86Sleep" - , "XF86Favorites" - , "XF86AudioPause" - , "XF86AudioMedia" - , "XF86MyComputer" - , "XF86VendorHome" - , "XF86LightBulb" - , "XF86Shop" - , "XF86History" - , "XF86OpenURL" - , "XF86AddFavorite" - , "XF86HotLinks" - , "XF86BrightnessAdjust" - , "XF86Finance" - , "XF86Community" - , "XF86AudioRewind" - , "XF86BackForward" - , "XF86Launch0" - , "XF86Launch1" - , "XF86Launch2" - , "XF86Launch3" - , "XF86Launch4" - , "XF86Launch5" - , "XF86Launch6" - , "XF86Launch7" - , "XF86Launch8" - , "XF86Launch9" - , "XF86LaunchA" - , "XF86LaunchB" - , "XF86LaunchC" - , "XF86LaunchD" - , "XF86LaunchE" - , "XF86LaunchF" - , "XF86ApplicationLeft" - , "XF86ApplicationRight" - , "XF86Book" - , "XF86CD" - , "XF86Calculater" - , "XF86Clear" - , "XF86Close" - , "XF86Copy" - , "XF86Cut" - , "XF86Display" - , "XF86DOS" - , "XF86Documents" - , "XF86Excel" - , "XF86Explorer" - , "XF86Game" - , "XF86Go" - , "XF86iTouch" - , "XF86LogOff" - , "XF86Market" - , "XF86Meeting" - , "XF86MenuKB" - , "XF86MenuPB" - , "XF86MySites" - , "XF86New" - , "XF86News" - , "XF86OfficeHome" - , "XF86Open" - , "XF86Option" - , "XF86Paste" - , "XF86Phone" - , "XF86Q" - , "XF86Reply" - , "XF86Reload" - , "XF86RotateWindows" - , "XF86RotationPB" - , "XF86RotationKB" - , "XF86Save" - , "XF86ScrollUp" - , "XF86ScrollDown" - , "XF86ScrollClick" - , "XF86Send" - , "XF86Spell" - , "XF86SplitScreen" - , "XF86Support" - , "XF86TaskPane" - , "XF86Terminal" - , "XF86Tools" - , "XF86Travel" - , "XF86UserPB" - , "XF86User1KB" - , "XF86User2KB" - , "XF86Video" - , "XF86WheelButton" - , "XF86Word" - , "XF86Xfer" - , "XF86ZoomIn" - , "XF86ZoomOut" - , "XF86Away" - , "XF86Messenger" - , "XF86WebCam" - , "XF86MailForward" - , "XF86Pictures" - , "XF86Music" - , "XF86TouchpadToggle" - , "XF86AudioMicMute" - , "XF86_Switch_VT_1" - , "XF86_Switch_VT_2" - , "XF86_Switch_VT_3" - , "XF86_Switch_VT_4" - , "XF86_Switch_VT_5" - , "XF86_Switch_VT_6" - , "XF86_Switch_VT_7" - , "XF86_Switch_VT_8" - , "XF86_Switch_VT_9" - , "XF86_Switch_VT_10" - , "XF86_Switch_VT_11" - , "XF86_Switch_VT_12" - , "XF86_Ungrab" - , "XF86_ClearGrab" - , "XF86_Next_VMode" - , "XF86_Prev_VMode" - , "XF86Bluetooth" ] - -- | Given a configuration record and a list of (key sequence -- description, action) pairs, check the key sequence descriptions -- for validity, and warn the user (via a popup xmessage window) of From 153d46fd9042008210353d41645e84d2bf30d566 Mon Sep 17 00:00:00 2001 From: slotThe Date: Sat, 5 Feb 2022 10:40:58 +0100 Subject: [PATCH 3/3] tests: Add property tests for X.U.EZConfig MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adds property tests in both directions for the parser in X.U.EZConfig. As with the tests for X.P.OrgMode, these (modulo `Maybe` noise) take the shape of the operation of an inverse semigroup: pp ∘ p ∘ pp ≡ pp and p ∘ pp ∘ p = p, where pp is pretty-printing and p is parsing. --- tests/EZConfig.hs | 71 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 63 insertions(+), 8 deletions(-) diff --git a/tests/EZConfig.hs b/tests/EZConfig.hs index 5b677b50..ac81a48f 100644 --- a/tests/EZConfig.hs +++ b/tests/EZConfig.hs @@ -1,7 +1,16 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} module EZConfig (spec) where -import Control.Arrow (first) +import Control.Arrow (first, (>>>)) +import Data.Coerce +import Foreign.C.Types (CUInt(..)) import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck import XMonad import XMonad.Prelude import XMonad.Util.EZConfig @@ -9,10 +18,13 @@ import XMonad.Util.Parser spec :: Spec spec = do + prop "prop_decodePreservation" prop_decodePreservation + prop "prop_encodePreservation" prop_encodePreservation + context "parseKey" $ do let prepare = unzip . map (first surround) testParseKey (ns, ks) = traverse (runParser parseKey) ns `shouldBe` Just ks - it "parses all regular keys" $ testParseKey regularKeys + it "parses all regular keys" $ testParseKey (unzip regularKeys ) it "parses all function keys" $ testParseKey (prepare functionKeys ) it "parses all special keys" $ testParseKey (prepare specialKeys ) it "parses all multimedia keys" $ testParseKey (prepare multimediaKeys) @@ -30,15 +42,58 @@ spec = do it "Fails on the non-existent key M-10" $ readKeySequence def "M-10" `shouldBe` Nothing -regularKeys :: ([String], [KeySym]) -regularKeys = unzip . map (first (: "")) - $ zip ['!' .. '~' ] [xK_exclam .. xK_asciitilde] - ++ zip ['\xa0' .. '\xff'] [xK_nobreakspace .. xK_ydiaeresis] +-- | Parsing preserves all info that printing does. +prop_encodePreservation :: KeyString -> Property +prop_encodePreservation (coerce -> s) = parse s === (parse . pp =<< parse s) + where parse = runParser (parseKeySequence def) + pp = unwords . map keyToString + +-- | Printing preserves all info that parsing does. +prop_decodePreservation :: NonEmptyList (AKeyMask, AKeySym) -> Property +prop_decodePreservation (getNonEmpty >>> coerce -> xs) = + Just (pp xs) === (fmap pp . parse $ pp xs) + where parse = runParser (parseKeySequence def) + pp = unwords . map keyToString -- | QuickCheck can handle the 8! combinations just fine. modifiers :: [String] -modifiers = map concat $ - permutations ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"] +modifiers = map concat $ permutations mods + +mods :: [String] +mods = ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"] surround :: String -> String surround s = "<" <> s <> ">" + +----------------------------------------------------------------------- +-- Newtypes and Arbitrary instances + +newtype AKeyMask = AKeyMask KeyMask + deriving newtype (Show) + +instance Arbitrary AKeyMask where + arbitrary :: Gen AKeyMask + arbitrary = fmap (coerce . sum . nub) . listOf . elements $ + [noModMask, shiftMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask] + +newtype AKeySym = AKeySym KeySym + deriving newtype (Show) + +instance Arbitrary AKeySym where + arbitrary :: Gen AKeySym + arbitrary = elements . coerce . map snd $ regularKeys <> allSpecialKeys + +newtype KeyString = KeyString String + deriving newtype (Show) + +instance Arbitrary KeyString where + arbitrary :: Gen KeyString + arbitrary = coerce . unwords <$> listOf keybinding + where + keybinding :: Gen String + keybinding = do + let keyStr = map fst $ regularKeys <> allSpecialKeys + mks <- nub <$> listOf (elements ("" : mods)) + k <- elements keyStr + ks <- listOf . elements $ keyStr + pure $ concat mks <> k <> " " <> unwords ks