{-# LANGUAGE FlexibleContexts #-} ---------------------------------------------------------------------------- -- | -- Module : ConfigParser -- Copyright : (c) Jan Vornberger 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This module helps to parse Bluetile's configuration file -- ----------------------------------------------------------------------------- module ConfigParser ( parseConfigFile, BluetileRC(..), displayIdentifiers ) where import XMonad import qualified Data.ConfigFile as CF import Control.Monad.Error import Data.Char import Data.List import Text.Regex import System.Exit data BluetileRC = BluetileRC { defaultModifierBRC :: KeyMask , focusFollowsMouseBRC :: Bool , terminalBRC :: String , startDockBRC :: Bool , keysBRC :: [(String, (KeyMask, KeySym))] , decorationBRC :: [(String, String)] } deriving (Show) maskKeywordsBRC :: [(String, KeyMask)] maskKeywordsBRC = [ ("Shift", shiftMask) , ("Lock", lockMask) , ("Ctrl", controlMask) , ("Mod1", mod1Mask) , ("Mod2", mod2Mask) , ("Mod3", mod3Mask) , ("Mod4", mod4Mask) , ("Mod5", mod5Mask) ] keysKeywordsBRC :: [(String, KeySym)] keysKeywordsBRC = [ ("BackSpace", xK_BackSpace) , ("Tab", xK_Tab) , ("Linefeed", xK_Linefeed) , ("Clear", xK_Clear) , ("Return", xK_Return) , ("Pause", xK_Pause) , ("Scroll_Lock", xK_Scroll_Lock) , ("Sys_Req", xK_Sys_Req) , ("Escape", xK_Escape) , ("Delete", xK_Delete) , ("Home", xK_Home) , ("Left", xK_Left) , ("Up", xK_Up) , ("Right", xK_Right) , ("Down", xK_Down) , ("Prior", xK_Prior) , ("Page_Up", xK_Page_Up) , ("Next", xK_Next) , ("Page_Down", xK_Page_Down) , ("End", xK_End) , ("Begin", xK_Begin) , ("Select", xK_Select) , ("Print", xK_Print) , ("Execute", xK_Execute) , ("Insert", xK_Insert) , ("Undo", xK_Undo) , ("Redo", xK_Redo) , ("Menu", xK_Menu) , ("Find", xK_Find) , ("Cancel", xK_Cancel) , ("Help", xK_Help) , ("Break", xK_Break) , ("Num_Lock", xK_Num_Lock) , ("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) , ("F1", xK_F1) , ("F2", xK_F2) , ("F3", xK_F3) , ("F4", xK_F4) , ("F5", xK_F5) , ("F6", xK_F6) , ("F7", xK_F7) , ("F8", xK_F8) , ("F9", xK_F9) , ("F10", xK_F10) , ("F11", xK_F11) , ("L1", xK_L1) , ("F12", xK_F12) , ("L2", xK_L2) , ("F13", xK_F13) , ("L3", xK_L3) , ("F14", xK_F14) , ("L4", xK_L4) , ("F15", xK_F15) , ("L5", xK_L5) , ("F16", xK_F16) , ("L6", xK_L6) , ("F17", xK_F17) , ("L7", xK_L7) , ("F18", xK_F18) , ("L8", xK_L8) , ("F19", xK_F19) , ("L9", xK_L9) , ("F20", xK_F20) , ("L10", xK_L10) , ("F21", xK_F21) , ("R1", xK_R1) , ("F22", xK_F22) , ("R2", xK_R2) , ("F23", xK_F23) , ("R3", xK_R3) , ("F24", xK_F24) , ("R4", xK_R4) , ("F25", xK_F25) , ("R5", xK_R5) , ("F26", xK_F26) , ("R6", xK_R6) , ("F27", xK_F27) , ("R7", xK_R7) , ("F28", xK_F28) , ("R8", xK_R8) , ("F29", xK_F29) , ("R9", xK_R9) , ("F30", xK_F30) , ("R10", xK_R10) , ("F31", xK_F31) , ("R11", xK_R11) , ("F32", xK_F32) , ("R12", xK_R12) , ("F33", xK_F33) , ("R13", xK_R13) , ("F34", xK_F34) , ("R14", xK_R14) , ("F35", xK_F35) , ("R15", xK_R15) , ("space", xK_space) , ("exclam", xK_exclam) , ("quotedbl", xK_quotedbl) , ("numbersign", xK_numbersign) , ("dollar", xK_dollar) , ("percent", xK_percent) , ("ampersand", xK_ampersand) , ("apostrophe", xK_apostrophe) , ("quoteright", xK_quoteright) , ("parenleft", xK_parenleft) , ("parenright", xK_parenright) , ("asterisk", xK_asterisk) , ("plus", xK_plus) , ("comma", xK_comma) , ("minus", xK_minus) , ("period", xK_period) , ("slash", xK_slash) , ("0", xK_0) , ("1", xK_1) , ("2", xK_2) , ("3", xK_3) , ("4", xK_4) , ("5", xK_5) , ("6", xK_6) , ("7", xK_7) , ("8", xK_8) , ("9", xK_9) , ("colon", xK_colon) , ("semicolon", xK_semicolon) , ("less", xK_less) , ("equal", xK_equal) , ("greater", xK_greater) , ("question", xK_question) , ("at", xK_at) , ("bracketleft", xK_bracketleft) , ("backslash", xK_backslash) , ("bracketright", xK_bracketright) , ("asciicircum", xK_asciicircum) , ("underscore", xK_underscore) , ("grave", xK_grave) , ("quoteleft", xK_quoteleft) , ("a", xK_a) , ("b", xK_b) , ("c", xK_c) , ("d", xK_d) , ("e", xK_e) , ("f", xK_f) , ("g", xK_g) , ("h", xK_h) , ("i", xK_i) , ("j", xK_j) , ("k", xK_k) , ("l", xK_l) , ("m", xK_m) , ("n", xK_n) , ("o", xK_o) , ("p", xK_p) , ("q", xK_q) , ("r", xK_r) , ("s", xK_s) , ("t", xK_t) , ("u", xK_u) , ("v", xK_v) , ("w", xK_w) , ("x", xK_x) , ("y", xK_y) , ("z", xK_z) , ("braceleft", xK_braceleft) , ("bar", xK_bar) , ("braceright", xK_braceright) , ("asciitilde", xK_asciitilde) , ("nobreakspace", xK_nobreakspace) , ("exclamdown", xK_exclamdown) , ("cent", xK_cent) , ("sterling", xK_sterling) , ("currency", xK_currency) , ("yen", xK_yen) , ("brokenbar", xK_brokenbar) , ("section", xK_section) , ("diaeresis", xK_diaeresis) , ("copyright", xK_copyright) , ("ordfeminine", xK_ordfeminine) , ("guillemotleft", xK_guillemotleft) , ("notsign", xK_notsign) , ("hyphen", xK_hyphen) , ("registered", xK_registered) , ("macron", xK_macron) , ("degree", xK_degree) , ("plusminus", xK_plusminus) , ("twosuperior", xK_twosuperior) , ("threesuperior", xK_threesuperior) , ("acute", xK_acute) , ("mu", xK_mu) , ("paragraph", xK_paragraph) , ("periodcentered", xK_periodcentered) , ("cedilla", xK_cedilla) , ("onesuperior", xK_onesuperior) , ("masculine", xK_masculine) , ("guillemotright", xK_guillemotright) , ("onequarter", xK_onequarter) , ("onehalf", xK_onehalf) , ("threequarters", xK_threequarters) , ("questiondown", xK_questiondown) , ("Agrave", xK_Agrave) , ("Aacute", xK_Aacute) , ("Acircumflex", xK_Acircumflex) , ("Atilde", xK_Atilde) , ("Adiaeresis", xK_Adiaeresis) , ("Aring", xK_Aring) , ("AE", xK_AE) , ("Ccedilla", xK_Ccedilla) , ("Egrave", xK_Egrave) , ("Eacute", xK_Eacute) , ("Ecircumflex", xK_Ecircumflex) , ("Ediaeresis", xK_Ediaeresis) , ("Igrave", xK_Igrave) , ("Iacute", xK_Iacute) , ("Icircumflex", xK_Icircumflex) , ("Idiaeresis", xK_Idiaeresis) , ("ETH", xK_ETH) , ("Eth", xK_Eth) , ("Ntilde", xK_Ntilde) , ("Ograve", xK_Ograve) , ("Oacute", xK_Oacute) , ("Ocircumflex", xK_Ocircumflex) , ("Otilde", xK_Otilde) , ("Odiaeresis", xK_Odiaeresis) , ("multiply", xK_multiply) , ("Ooblique", xK_Ooblique) , ("Ugrave", xK_Ugrave) , ("Uacute", xK_Uacute) , ("Ucircumflex", xK_Ucircumflex) , ("Udiaeresis", xK_Udiaeresis) , ("Yacute", xK_Yacute) , ("THORN", xK_THORN) , ("Thorn", xK_Thorn) , ("ssharp", xK_ssharp) , ("agrave", xK_agrave) , ("aacute", xK_aacute) , ("acircumflex", xK_acircumflex) , ("atilde", xK_atilde) , ("adiaeresis", xK_adiaeresis) , ("aring", xK_aring) , ("ae", xK_ae) , ("ccedilla", xK_ccedilla) , ("egrave", xK_egrave) , ("eacute", xK_eacute) , ("ecircumflex", xK_ecircumflex) , ("ediaeresis", xK_ediaeresis) , ("igrave", xK_igrave) , ("iacute", xK_iacute) , ("icircumflex", xK_icircumflex) , ("idiaeresis", xK_idiaeresis) , ("eth", xK_eth) , ("ntilde", xK_ntilde) , ("ograve", xK_ograve) , ("oacute", xK_oacute) , ("ocircumflex", xK_ocircumflex) , ("otilde", xK_otilde) , ("odiaeresis", xK_odiaeresis) , ("division", xK_division) , ("oslash", xK_oslash) , ("ugrave", xK_ugrave) , ("uacute", xK_uacute) , ("ucircumflex", xK_ucircumflex) , ("udiaeresis", xK_udiaeresis) , ("yacute", xK_yacute) , ("thorn", xK_thorn) , ("ydiaeresis", xK_ydiaeresis) ] maskKeywordsBRC' :: [(String, KeyMask)] maskKeywordsBRC' = map (\(k, v) -> (map toLower k, v)) maskKeywordsBRC keysKeywordsBRC' :: [(String, KeySym)] keysKeywordsBRC' = map (\(k, v) -> (map toLower k, v)) keysKeywordsBRC lookupMask :: MonadError CF.CPError m => [(String, KeyMask)] -> String -> m KeyMask lookupMask t k = case (lookup (map toLower k) t) of (Just v) -> return v (Nothing) -> throwError (CF.OtherProblem ("Unknown modifier '" ++ k ++ "'"), "other_problem") lookupKey :: MonadError CF.CPError m => String -> m KeySym lookupKey k = case (lookup (map toLower k) keysKeywordsBRC') of (Just v) -> return v (Nothing) -> throwError (CF.OtherProblem ("Unknown key '" ++ k ++ "'"), "other_problem") parseKeyCombo :: MonadError CF.CPError m => [(String, KeyMask)] -> String -> m (KeyMask, KeySym) parseKeyCombo maskKBRC combo = do let parts = splitRegex (mkRegex "\\+") combo if (length parts > 0) then do masks <- mapM (lookupMask maskKBRC) (init parts) key <- lookupKey (last parts) return (foldl (.|.) 0 masks, key) else throwError (CF.OtherProblem ("Empty key binding"), "other_problem") parseKeyBinding :: MonadError CF.CPError m => [(String, KeyMask)] -> (String, String) -> m (String, (KeyMask, KeySym)) parseKeyBinding maskKBRC (desc, keyCombo) = do keyBinding <- parseKeyCombo maskKBRC keyCombo return (desc, keyBinding) parseConfigFile :: FilePath -> FilePath -> IO BluetileRC parseConfigFile systemConfig userConfig = do rv <- runErrorT $ do -- read files cpDefault <- join $ liftIO $ CF.readfile CF.emptyCP systemConfig cp <- join $ liftIO $ CF.readfile cpDefault userConfig -- global options defaultModifierCF <- lookupMask maskKeywordsBRC' =<< CF.get cp "DEFAULT" "default_modifier" terminalCF <- CF.get cp "DEFAULT" "terminal" focusFollowsMouseCF <- CF.get cp "DEFAULT" "focus_follows_mouse" startDockCF <- CF.get cp "DEFAULT" "start_dock" let maskKeywordsBRCwithDefault = maskKeywordsBRC' ++ [("defaultmod", defaultModifierCF)] -- theme itemsCF <- CF.items cp "DEFAULT" let colorsCF = filter (\(k, _) -> isPrefixOf "decoration_" k) itemsCF ++ filter (\(k, _) -> isPrefixOf "window_border_" k) itemsCF -- keys let keyBindingsCFstr = filter (\(k, _) -> isPrefixOf "key_" k) itemsCF keyBindingsCF <- mapM (parseKeyBinding maskKeywordsBRCwithDefault) keyBindingsCFstr let bluetilerc = BluetileRC { defaultModifierBRC = defaultModifierCF , focusFollowsMouseBRC = focusFollowsMouseCF , terminalBRC = terminalCF , startDockBRC = startDockCF , keysBRC = keyBindingsCF , decorationBRC = colorsCF } return bluetilerc case rv of (Left err) -> do putStrLn "There was a problem reading the configuration. This is what the parser told me:" putStrLn (show err) exitFailure (Right bluetilerc) -> do return bluetilerc displayIdentifiers :: IO () displayIdentifiers = do putStrLn "The following modifiers can be used in Bluetile's configuration:" putStrLn $ concat $ intersperse ", " ("DefaultMod" : (map fst maskKeywordsBRC)) putStrLn "" putStrLn "The following keys can be used in Bluetile's configuration:" putStrLn $ concat $ intersperse ", " (map fst keysKeywordsBRC)