Files
xmonad/util/GenerateManpage.hs
2025-06-14 13:53:09 -04:00

74 lines
2.3 KiB
Haskell
Executable File

#!/usr/bin/env runhaskell
-- Reads markdown (man/xmonad.1.markdown) from stdin, substitutes
-- ___KEYBINDINGS___ for key-binding definitions generated from
-- src/XMonad/Config.hs, prints result to stdout.
--
-- Unlike the rest of xmonad, this file is released under the GNU General
-- Public License version 2 or later. (Historical reasons, used to link with
-- GPL-licensed pandoc.)
import Data.Char
import Data.List
main :: IO ()
main = do
keybindings <- guessBindings
interact $ unlines . replace "___KEYBINDINGS___" keybindings . lines
-- | The format for the docstrings in "Config.hs" takes the following form:
--
-- @
-- -- mod-x %! Frob the whatsit
-- @
--
-- "Frob the whatsit" will be used as the description for keybinding "mod-x".
-- If the name of the key binding is omitted, the function tries to guess it
-- from the rest of the line. For example:
--
-- @
-- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm
-- @
--
-- Here, "mod-shift-return" will be used as the key binding name.
guessBindings :: IO String
guessBindings = do
buf <- readFile "./src/XMonad/Config.hs"
return (intercalate "\n\n" (map markdownDefn (allBindings buf)))
allBindings :: String -> [(String, String)]
allBindings = concatMap parseLine . lines
where
parseLine :: String -> [(String, String)]
parseLine l
| " -- " `isInfixOf` l
, Just d <- parseDesc l = [(intercalate "-" (parseKeys l), d)]
| otherwise = []
parseDesc :: String -> Maybe String
parseDesc = fmap (trim . drop 4) . find (" %! " `isPrefixOf`) . tails
parseKeys :: String -> [String]
parseKeys l = case lex l of
[("", _)] -> []
[("--", rest)] -> case words rest of
k : "%!" : _ -> [k]
_ -> []
[(k, rest)] -> parseKey k ++ parseKeys rest
parseKey :: String -> [String]
parseKey k | "Mask" `isSuffixOf` k = [reverse (drop 4 (reverse k))]
| "xK_" `isPrefixOf` k = [map toLower (drop 3 k)]
| otherwise = []
-- FIXME: What escaping should we be doing on these strings?
markdownDefn :: (String, String) -> String
markdownDefn (key, desc) = key ++ "\n: " ++ desc
replace :: Eq a => a -> a -> [a] -> [a]
replace x y = map (\a -> if a == x then y else a)
trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace