From 8b3df5b26840893c7d6b1449f6d83ec1a045c32b Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 29 Nov 2021 11:33:55 +0100 Subject: [PATCH 1/4] New module: XMonad.Util.Parser This module provides a parser combinator library based on base's ReadP, which aims to function more like other popular combinator libraries like attoparsec and megaparsec. In particular, the Alternative and Monoid instances are left-biased now, so combinators like `many` and `optional` from Control.Applicative work in a more intuitive manner. Further, some functions (like `endBy1`) only return the "most successful" parse, instead of returning all of them. We can now get away with providing a single parsing result instead of ReadP's list of results (as such, parsers need to be disambiguated earlier instead of trimming the list down after parsing). --- CHANGES.md | 5 + XMonad/Util/Parser.hs | 215 ++++++++++++++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 2 + 3 files changed, 222 insertions(+) create mode 100644 XMonad/Util/Parser.hs diff --git a/CHANGES.md b/CHANGES.md index bf66815a70..7589053a72 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -21,6 +21,11 @@ While XMonad provides config to set all window borders at the same width, this extension defines and sets border width for each window. + * `XMonad.Util.Parser` + + A wrapper around the 'ReadP' parser combinator, providing behaviour + that's closer to the more popular parser combinator libraries. + ### Bug Fixes and Minor Changes * `XMonad.Prompt` diff --git a/XMonad/Util/Parser.hs b/XMonad/Util/Parser.hs new file mode 100644 index 0000000000..044f2ef9d3 --- /dev/null +++ b/XMonad/Util/Parser.hs @@ -0,0 +1,215 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeApplications #-} +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Parser +-- Description : A parser combinator library for xmonad +-- Copyright : (c) 2021 slotThe +-- License : BSD3 +-- Maintainer : slotThe +-- Stability : experimental +-- Portability : non-portable +-- +-- A small wrapper around the 'ReadP' parser combinator in @base@, +-- providing a more intuitive behaviour. While it's theoretically nice +-- that 'ReadP' is actually commutative, this makes a lot of parsing +-- operations rather awkward—more often than not, one only wants the +-- argument that's parsed "first". +-- +-- Due to the left-biased nature of the chosen semigroup implementation, +-- using functions like 'many' or 'optional' from "Control.Applicative" +-- now yields more consistent behaviour with other parser combinator +-- libraries. +-- +-------------------------------------------------------------------- +module XMonad.Util.Parser ( + -- * Usage + -- $usage + + -- * Running + Parser, + runParser, + + -- * Primitive Parsers + eof, + num, + char, + string, + skipSpaces, + get, + look, + + -- * Combining Parsers + satisfy, + choice, + many1, + sepBy, + sepBy1, + endBy, + endBy1, + munch, + munch1, +) where + +import XMonad.Prelude + +import qualified Text.ParserCombinators.ReadP as ReadP + +import Data.Coerce (coerce) +import Text.ParserCombinators.ReadP (ReadP, (<++)) + +{- $usage + +NOTE: This module is mostly intended for developing of other modules. +If you are a users, you probably won't find much use here—you have been +warned. + +The high-level API tries to stay as close to 'ReadP' as possible. If +you are familiar with that then no functions here should surprise you. + +One notable usability difference when forcing left-biasedness is /when/ +one wants to disambiguate a parse. For normal 'ReadP' usage this +happens after the actual parsing stage by going through the list of +successful parses. For 'Parser' it does when constructing the relevant +combinators, leading to only one successful parse. As an example, +consider the 'ReadP'-based parser + +> pLangle = ReadP.string "<" +> pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>' +> pCombination = pLangle ReadP.+++ pLongerSequence + +Parsing the string @""@ will return + +>>> ReadP.readP_to_S pCombination "" +[("<","f>"),("f","")] + +One would now need to, for example, filter for the second (leftover) +string being empty and take the head of the resulting list (which may +still have more than one element). + +With 'Parser', the same situation would look like the following + +> pLangle' = string "<" +> pLongerSequence' = char '<' *> string "f" <* char '>' +> pCombination' = pLongerSequence' <> pLangle' + +Notice how @pLangle'@ and @pLongerSequence'@ have traded places—since we +are not forcing @pLangle'@ to consume the entire string and @(<>)@ is +left-biased, @pLongerSequence'@ parses a superset of @pLangle'@! +Running @runParser pCombination'@ now yields the expected result: + +>>> runParser pCombination' "" +Just "f" + +One might also define @pLangle'@ as @string "<" <* eof@, which would +enable a definition of @pCombination' = pLangle' <> pLongerSequence'@. + +For example uses, see "XMonad.Util.EZConfig" or "XMonad.Prompt.OrgMode". +-} + +-- Parser :: Type -> Type +newtype Parser a = Parser (ReadP a) + deriving newtype (Functor, Applicative, Monad) + +instance Semigroup (Parser a) where + -- | Local, exclusive, left-biased choice: If left parser locally + -- produces any result at all, then right parser is not used. + (<>) :: Parser a -> Parser a -> Parser a + (<>) = coerce ((<++) @a) + +instance Monoid (Parser a) where + -- | A parser that always fails. + mempty :: Parser a + mempty = Parser empty + +instance Alternative Parser where + empty :: Parser a + empty = mempty + + (<|>) :: Parser a -> Parser a -> Parser a + (<|>) = (<>) + +-- | Run a parser on a given string. +runParser :: Parser a -> String -> Maybe a +runParser (Parser p) = fmap fst . listToMaybe . ReadP.readP_to_S p + +-- | Consume and return the next character. Fails if there is no input +-- left. +get :: Parser Char +get = coerce ReadP.get + +-- | Look-ahead: return the part of the input that is left, without +-- consuming it. +look :: Parser String +look = coerce ReadP.look + +-- | Succeeds if and only if we are at the end of input. +eof :: Parser () +eof = coerce ReadP.eof + +-- | Parse an integral number number. +num :: (Read a, Integral a) => Parser a +num = read <$> munch1 isDigit +{-# SPECIALISE num :: Parser Word #-} +{-# SPECIALISE num :: Parser Int #-} +{-# SPECIALISE num :: Parser Integer #-} + +-- | Parse and return the specified character. +char :: Char -> Parser Char +char = coerce ReadP.char + +-- | Parse and return the specified string. +string :: String -> Parser String +string = coerce ReadP.string + +-- | Skip all whitespace. +skipSpaces :: Parser () +skipSpaces = coerce ReadP.skipSpaces + +-- | Consume and return the next character if it satisfies the specified +-- predicate. +satisfy :: (Char -> Bool) -> Parser Char +satisfy = coerce ReadP.satisfy + +-- | Combine all parsers in the given list in a left-biased way. +choice :: [Parser a] -> Parser a +choice = foldl' (<>) mempty + +-- | Parse the first zero or more characters satisfying the predicate. +-- Always succeeds; returns an empty string if the predicate returns +-- @False@ on the first character of input. +munch :: (Char -> Bool) -> Parser String +munch = coerce ReadP.munch + +-- | Parse the first one or more characters satisfying the predicate. +-- Fails if none, else succeeds exactly once having consumed all the +-- characters. +munch1 :: (Char -> Bool) -> Parser String +munch1 = coerce ReadP.munch1 + +-- | @endBy p sep@ parses zero or more occurrences of @p@, separated and +-- ended by @sep@. +endBy :: Parser a -> Parser sep -> Parser [a] +endBy p sep = many (p <* sep) + +-- | @endBy p sep@ parses one or more occurrences of @p@, separated and +-- ended by @sep@. +endBy1 :: Parser a -> Parser sep -> Parser [a] +endBy1 p sep = many1 (p <* sep) + +-- | Parse one or more occurrences of the given parser. +many1 :: Parser a -> Parser [a] +many1 p = liftA2 (:) p (many p) + +-- | @sepBy p sep@ parses zero or more occurrences of @p@, separated by +-- @sep@. Returns a list of values returned by @p@. +sepBy :: Parser a -> Parser sep -> Parser [a] +sepBy p sep = sepBy1 p sep <> pure [] + +-- | @sepBy1 p sep@ parses one or more occurrences of @p@, separated by +-- @sep@. Returns a list of values returned by @p@. +sepBy1 :: Parser a -> Parser sep -> Parser [a] +sepBy1 p sep = liftA2 (:) p (many (sep *> p)) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 398b552b2c..931224f377 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -359,6 +359,7 @@ library XMonad.Util.NamedScratchpad XMonad.Util.NamedWindows XMonad.Util.NoTaskbar + XMonad.Util.Parser XMonad.Util.Paste XMonad.Util.PositionStore XMonad.Util.PureX @@ -427,6 +428,7 @@ test-suite tests XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.NamedWindows + XMonad.Util.Parser XMonad.Util.PureX XMonad.Util.Rectangle XMonad.Util.Run From b1532e666f0808ff1bc39ea288b50ed8e17278a7 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 29 Nov 2021 11:47:16 +0100 Subject: [PATCH 2/4] X.P.OrgMode: Use X.U.Parser Since we now have an "internal" parser library in xmonad, use it. This allows us to get rid of some hacks in this module that were needed because of ReadP's parsing behaviour. --- XMonad/Prompt/OrgMode.hs | 106 ++++++++++++++------------------------- 1 file changed, 39 insertions(+), 67 deletions(-) diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs index 396bc8a13a..e26eec1689 100644 --- a/XMonad/Prompt/OrgMode.hs +++ b/XMonad/Prompt/OrgMode.hs @@ -53,12 +53,12 @@ import XMonad.Prelude import XMonad (X, io) import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt) +import XMonad.Util.Parser import XMonad.Util.XSelection (getSelection) import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian) import System.Directory (getHomeDirectory) import System.IO (IOMode (AppendMode), hPutStrLn, withFile) -import Text.ParserCombinators.ReadP (ReadP, munch, munch1, readP_to_S, skipSpaces, string, (<++)) {- $usage @@ -357,13 +357,13 @@ ppNote clp todo = \case -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note -pInput inp = fmap fst . listToMaybe . (`readP_to_S` inp) . lchoice $ +pInput inp = (`runParser` inp) . choice $ [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) , Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) , NormalMsg <$> munch1 (const True) ] where - getLast :: String -> ReadP String + getLast :: String -> Parser String getLast ptn = reverse . dropWhile (== ' ') -- trim whitespace at the end . drop (length ptn) -- drop only the last pattern @@ -371,82 +371,54 @@ pInput inp = fmap fst . listToMaybe . (`readP_to_S` inp) . lchoice $ . concat <$> endBy1 (go "") (pure ptn) where - go :: String -> ReadP String + go :: String -> Parser String go consumed = do str <- munch (/= head ptn) word <- munch1 (/= ' ') bool go pure (word == ptn) $ consumed <> str <> word -- | Try to parse a 'Time'. -pTimeOfDay :: ReadP (Maybe TimeOfDay) -pTimeOfDay = lchoice - [ Just <$> (TimeOfDay <$> pInt <* string ":" <*> pInt ) -- HH:MM - , Just <$> (TimeOfDay <$> pInt <*> pure 0) -- HH +pTimeOfDay :: Parser (Maybe TimeOfDay) +pTimeOfDay = choice + [ Just <$> (TimeOfDay <$> num <* string ":" <*> num ) -- HH:MM + , Just <$> (TimeOfDay <$> num <*> pure 0) -- HH , pure Nothing ] -- | Parse a 'Date'. -pDate :: ReadP Date -pDate = skipSpaces *> lchoice - [ pString "tod" "ay" Today - , pString "tom" "orrow" Tomorrow - , Next <$> pNext - , Date <$> pDate1 <++ pDate2 <++ pDate3 +pDate :: Parser Date +pDate = skipSpaces *> choice + [ pPrefix "tod" "ay" Today + , pPrefix "tom" "orrow" Tomorrow + , Next <$> pNext + , Date <$> pDate' ] <* skipSpaces -- cleanup where - pNext :: ReadP DayOfWeek = lchoice - [ pString "m" "onday" Monday , pString "tu" "esday" Tuesday - , pString "w" "ednesday" Wednesday, pString "th" "ursday" Thursday - , pString "f" "riday" Friday , pString "sa" "turday" Saturday - , pString "su" "nday" Sunday + pNext :: Parser DayOfWeek = choice + [ pPrefix "m" "onday" Monday , pPrefix "tu" "esday" Tuesday + , pPrefix "w" "ednesday" Wednesday, pPrefix "th" "ursday" Thursday + , pPrefix "f" "riday" Friday , pPrefix "sa" "turday" Saturday + , pPrefix "su" "nday" Sunday ] - -- XXX: This is really horrible, but I can't see a way to not have - -- exponential blowup with ReadP otherwise. - pDate1, pDate2, pDate3 :: ReadP (Int, Maybe Int, Maybe Integer) - pDate1 = pDate' (fmap Just) (fmap Just) - pDate2 = pDate' (fmap Just) (const (pure Nothing)) - pDate3 = pDate' (const (pure Nothing)) (const (pure Nothing)) - pDate' - :: (ReadP Int -> ReadP (f Int )) - -> (ReadP Integer -> ReadP (f Integer)) - -> ReadP (Int, f Int, f Integer) - pDate' p p' = - (,,) <$> pInt - <*> p (skipSpaces *> lchoice - [ pString "ja" "nuary" 1 , pString "f" "ebruary" 2 - , pString "mar" "ch" 3 , pString "ap" "ril" 4 - , pString "may" "" 5 , pString "jun" "e" 6 - , pString "jul" "y" 7 , pString "au" "gust" 8 - , pString "s" "eptember" 9 , pString "o" "ctober" 10 - , pString "n" "ovember" 11, pString "d" "ecember" 12 + pDate' :: Parser (Int, Maybe Int, Maybe Integer) + pDate' = + (,,) <$> num + <*> optional (skipSpaces *> choice + [ pPrefix "ja" "nuary" 1 , pPrefix "f" "ebruary" 2 + , pPrefix "mar" "ch" 3 , pPrefix "ap" "ril" 4 + , pPrefix "may" "" 5 , pPrefix "jun" "e" 6 + , pPrefix "jul" "y" 7 , pPrefix "au" "gust" 8 + , pPrefix "s" "eptember" 9 , pPrefix "o" "ctober" 10 + , pPrefix "n" "ovember" 11, pPrefix "d" "ecember" 12 ]) - <*> p' (skipSpaces *> pInt >>= \i -> guard (i >= 25) $> i) - --- | Parse a @start@ and see whether the rest of the word (separated by --- spaces) fits the @leftover@. -pString :: String -> String -> a -> ReadP a -pString start leftover ret = do - void $ string start - l <- munch (/= ' ') - guard (l `isPrefixOf` leftover) - pure ret - --- | Parse a number. -pInt :: (Read a, Integral a) => ReadP a -pInt = read <$> munch1 isDigit - --- | Like 'choice', but with '(<++)' instead of '(+++)', stopping --- parsing when the left-most parser succeeds. -lchoice :: [ReadP a] -> ReadP a -lchoice = foldl' (<++) empty - --- | Like 'Text.ParserCombinators.ReadP.endBy1', but only return the --- parse where @parser@ had the highest number of applications. -endBy1 :: ReadP a -> ReadP sep -> ReadP [a] -endBy1 parser sep = many1 (parser <* sep) - where - -- | Like 'Text.ParserCombinators.ReadP.many1', but use '(<++)' - -- instead of '(+++)'. - many1 :: ReadP a -> ReadP [a] - many1 p = (:) <$> p <*> (many1 p <++ pure []) + <*> optional (skipSpaces *> num >>= \i -> guard (i >= 25) $> i) + + -- | Parse a prefix and drop a potential suffix up to the next (space + -- separated) word. If successful, return @ret@. + pPrefix :: String -> String -> a -> Parser a + pPrefix start leftover ret = do + void $ string start + l <- munch (/= ' ') + guard (l `isPrefixOf` leftover) + pure ret From 8abeb81fd0693bd4ee914b522c0a2a2cfcfaf0dd Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 29 Nov 2021 16:16:58 +0100 Subject: [PATCH 3/4] X.U.EZConfig: Use X.U.Parser Using X.U.Parser works almost as a drop-in replacement for ReadP here. In some places (like `parseSpecial`) we need to be a little bit more careful when constructing the parser, but this is offset a much simpler `readKeySequence`. --- CHANGES.md | 6 +++++ XMonad/Util/EZConfig.hs | 50 +++++++++++++++++++---------------------- XMonad/Util/Paste.hs | 8 +++---- 3 files changed, 33 insertions(+), 31 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 7589053a72..3baf439c19 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,12 @@ ### Breaking Changes + * `XMonad.Util.EZConfig` + + - The functions `parseKey`, `parseKeyCombo`, and `parseKeySequence` + now return a `Parser` (from `XMonad.Util.Parser`) instead of a + `ReadP`. + ### New Modules * `XMonad.Layout.CenteredIfSingle` diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 43ff5a8b31..6539840271 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -39,16 +39,15 @@ module XMonad.Util.EZConfig ( import XMonad import XMonad.Actions.Submap -import XMonad.Prelude hiding (many) +import XMonad.Prelude import XMonad.Util.NamedActions +import XMonad.Util.Parser import Control.Arrow (first, (&&&)) import qualified Data.Map as M import Data.Ord (comparing) -import Text.ParserCombinators.ReadP - -- $usage -- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@: -- @@ -408,16 +407,15 @@ readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c)) -- | Parse a sequence of keys, returning Nothing if there is -- a parse failure (no parse, or ambiguous parse). readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)] -readKeySequence c = listToMaybe . parses - where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c) +readKeySequence c = runParser (parseKeySequence c) -- | Parse a sequence of key combinations separated by spaces, e.g. -- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2). -parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)] -parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ') +parseKeySequence :: XConfig l -> Parser [(KeyMask, KeySym)] +parseKeySequence c = parseKeyCombo c `sepBy1` many1 (char ' ') -- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s). -parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym) +parseKeyCombo :: XConfig l -> Parser (KeyMask, KeySym) parseKeyCombo c = do mods <- many (parseModifier c) k <- parseKey return (foldl' (.|.) 0 mods, k) @@ -425,23 +423,23 @@ parseKeyCombo c = do mods <- many (parseModifier c) -- | Parse a modifier: either M- (user-defined mod-key), -- C- (control), S- (shift), or M#- where # is an integer -- from 1 to 5 (mod1Mask through mod5Mask). -parseModifier :: XConfig l -> ReadP KeyMask -parseModifier c = (string "M-" >> return (modMask c)) - +++ (string "C-" >> return controlMask) - +++ (string "S-" >> return shiftMask) - +++ do _ <- char 'M' - n <- satisfy (`elem` ['1'..'5']) - _ <- char '-' - return $ indexMod (read [n] - 1) +parseModifier :: XConfig l -> Parser KeyMask +parseModifier c = (string "M-" $> modMask c) + <> (string "C-" $> controlMask) + <> (string "S-" $> shiftMask) + <> do _ <- char 'M' + n <- satisfy (`elem` ['1'..'5']) + _ <- char '-' + return $ indexMod (read [n] - 1) where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] -- | Parse an unmodified basic key, like @\"x\"@, @\"\"@, etc. -parseKey :: ReadP KeySym -parseKey = parseRegular +++ parseSpecial +parseKey :: Parser KeySym +parseKey = parseSpecial <> parseRegular -- | Parse a regular key name (represented by itself). -parseRegular :: ReadP KeySym -parseRegular = choice [ char s >> return k +parseRegular :: Parser KeySym +parseRegular = choice [ char s $> k | (s,k) <- zip ['!' .. '~' ] -- ASCII [xK_exclam .. xK_asciitilde] @@ -450,13 +448,11 @@ parseRegular = choice [ char s >> return k ] -- | Parse a special key name (one enclosed in angle brackets). -parseSpecial :: ReadP KeySym -parseSpecial = do _ <- char '<' - key <- choice [ string name >> return k - | (name,k) <- keyNames - ] - _ <- char '>' - return key +parseSpecial :: Parser KeySym +parseSpecial = do _ <- char '<' + choice [ k <$ string name <* char '>' + | (name, k) <- keyNames + ] -- | A list of all special key names and their associated KeySyms. keyNames :: [(String, KeySym)] diff --git a/XMonad/Util/Paste.hs b/XMonad/Util/Paste.hs index 79951e48a0..d0c8eb2f60 100644 --- a/XMonad/Util/Paste.hs +++ b/XMonad/Util/Paste.hs @@ -28,10 +28,10 @@ import Graphics.X11 import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent) import Control.Monad.Reader (asks) import XMonad.Operations (withFocused) -import XMonad.Prelude (isUpper, listToMaybe) +import XMonad.Prelude (isUpper, fromMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey) -import Text.ParserCombinators.ReadP (readP_to_S) +import XMonad.Util.Parser (runParser) {- $usage @@ -72,8 +72,8 @@ pasteString = mapM_ (\x -> if isUpper x || x `elem` "~!@#$%^&*()_+{}|:\"<>?" the outside ASCII. -} pasteChar :: KeyMask -> Char -> X () -pasteChar m c = sendKey m $ maybe (unicodeToKeysym c) fst - $ listToMaybe $ readP_to_S parseKey [c] +pasteChar m c = sendKey m $ fromMaybe (unicodeToKeysym c) + $ runParser parseKey [c] -- | Send a key with a modifier to the currently focused window. sendKey :: KeyMask -> KeySym -> X () From 520c51817a16cd100d96e785cba0f6d07e29044d Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 29 Nov 2021 17:48:03 +0100 Subject: [PATCH 4/4] X.U.EZConfig: Add simple unit tests Add very basic unit tests for EZConfig to see if it can parse all of the keys (and key combinations) that it promises to parse. The long-term goal here should be to write a pretty-printer for EZConfig and to check whether that's a proper inverse (either in the normal sense or in the inverse semigroup sense), as the tests for X.P.OrgMode do. --- XMonad/Util/EZConfig.hs | 7 ++++++- tests/EZConfig.hs | 39 +++++++++++++++++++++++++++++++++++++++ tests/Main.hs | 2 ++ xmonad-contrib.cabal | 4 ++++ 4 files changed, 51 insertions(+), 1 deletion(-) create mode 100644 tests/EZConfig.hs diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index 6539840271..847b0dd760 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.EZConfig @@ -34,7 +35,11 @@ module XMonad.Util.EZConfig ( parseKey, -- used by XMonad.Util.Paste parseKeyCombo, - parseKeySequence, readKeySequence + parseKeySequence, readKeySequence, +#ifdef TESTING + functionKeys, specialKeys, multimediaKeys, + parseModifier, +#endif ) where import XMonad diff --git a/tests/EZConfig.hs b/tests/EZConfig.hs new file mode 100644 index 0000000000..c7e3408a22 --- /dev/null +++ b/tests/EZConfig.hs @@ -0,0 +1,39 @@ +module EZConfig (spec) where + +import Control.Arrow (first) +import Test.Hspec +import XMonad +import XMonad.Prelude +import XMonad.Util.EZConfig +import XMonad.Util.Parser + +spec :: Spec +spec = do + 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 function keys" $ testParseKey (prepare functionKeys ) + it "parses all special keys" $ testParseKey (prepare specialKeys ) + it "parses all multimedia keys" $ testParseKey (prepare multimediaKeys) + context "parseModifier" $ do + it "parses all combinations of modifiers" $ + nub . map sort <$> traverse (runParser (many $ parseModifier def)) + modifiers + `shouldBe` Just [[ shiftMask, controlMask + , mod1Mask, mod1Mask -- def M and M1 + , mod2Mask, mod3Mask, mod4Mask, mod5Mask + ]] + +regularKeys :: ([String], [KeySym]) +regularKeys = unzip . map (first (: "")) + $ zip ['!' .. '~' ] [xK_exclam .. xK_asciitilde] + ++ zip ['\xa0' .. '\xff'] [xK_nobreakspace .. xK_ydiaeresis] + +-- | QuickCheck can handle the 8! combinations just fine. +modifiers :: [String] +modifiers = map concat $ + permutations ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"] + +surround :: String -> String +surround s = "<" <> s <> ">" diff --git a/tests/Main.hs b/tests/Main.hs index 7712f9532a..813ba921fd 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -13,6 +13,7 @@ import qualified XPrompt import qualified CycleRecentWS import qualified OrgMode import qualified GridSelect +import qualified EZConfig main :: IO () main = hspec $ do @@ -51,3 +52,4 @@ main = hspec $ do context "CycleRecentWS" CycleRecentWS.spec context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec + context "EZConfig" EZConfig.spec diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 931224f377..57d3488778 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -388,6 +388,7 @@ test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: CycleRecentWS + EZConfig ExtensibleConf GridSelect Instances @@ -404,6 +405,7 @@ test-suite tests XMonad.Actions.GridSelect XMonad.Actions.PhysicalScreens XMonad.Actions.RotateSome + XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.WindowBringer @@ -422,11 +424,13 @@ test-suite tests XMonad.Prompt.Shell XMonad.Util.Dmenu XMonad.Util.Dzen + XMonad.Util.EZConfig XMonad.Util.ExtensibleConf XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Image XMonad.Util.Invisible + XMonad.Util.NamedActions XMonad.Util.NamedWindows XMonad.Util.Parser XMonad.Util.PureX