diff options
| -rw-r--r-- | src/Main.hs | 112 |
1 files changed, 62 insertions, 50 deletions
diff --git a/src/Main.hs b/src/Main.hs index 1438ab5..30878d2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -52,8 +52,8 @@ main = do [cfgfile] -> readConfig cfgfile _ -> readDefaultConfig - unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: " - ++ intercalate "," defaultings + unless (null defaultings) $ putStrLn $ + "Fields missing from config defaulted: " ++ intercalate "," defaultings conf <- doOpts c o fs <- initFont d (font conf) @@ -72,9 +72,8 @@ splitTemplate conf = (ce,_:ri) -> [le, ce, ri] _ -> def _ -> def - where [l, r] = if length (alignSep conf) == 2 - then alignSep conf - else alignSep defaultConfig + where [l, r] = alignSep + (if length (alignSep conf) == 2 then conf else defaultConfig) t = template conf def = [t, "", ""] @@ -83,8 +82,10 @@ splitTemplate conf = readConfig :: FilePath -> IO (Config,[String]) readConfig f = do file <- io $ fileExist f - s <- io $ if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage - either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err) + s <- io $ if file then readFileSafe f else error $ + f ++ ": file not found!\n" ++ usage + either (\err -> error $ f ++ + ": configuration file contains errors at:\n" ++ show err) return $ parseConfig s -- | Read default configuration file or load the default config @@ -112,19 +113,29 @@ data Opts = Help options :: [OptDescr Opts] options = - [ Option ['h','?' ] ["help" ] (NoArg Help ) "This help" - , Option ['V' ] ["version" ] (NoArg Version ) "Show version information" - , Option ['f' ] ["font" ] (ReqArg Font "font name") "The font name" - , Option ['B' ] ["bgcolor" ] (ReqArg BgColor "bg color" ) "The background color. Default black" - , Option ['F' ] ["fgcolor" ] (ReqArg FgColor "fg color" ) "The foreground color. Default grey" - , Option ['o' ] ["top" ] (NoArg T ) "Place xmobar at the top of the screen" - , Option ['b' ] ["bottom" ] (NoArg B ) "Place xmobar at the bottom of the screen" - , Option ['a' ] ["alignsep" ] (ReqArg AlignSep "alignsep" ) "Separators for left, center and right text\nalignment. Default: '}{'" - , Option ['s' ] ["sepchar" ] (ReqArg SepChar "char" ) "The character used to separate commands in\nthe output template. Default '%'" - , Option ['t' ] ["template" ] (ReqArg Template "template" ) "The output template" - , Option ['c' ] ["commands" ] (ReqArg Commands "commands" ) "The list of commands to be executed" - , Option ['C' ] ["add-command" ] (ReqArg AddCommand "command" ) "Add to the list of commands to be executed" - , Option ['x' ] ["screen" ] (ReqArg OnScr "screen" ) "On which X screen number to start" + [ Option "h?" ["help"] (NoArg Help) "This help" + , Option "V" ["version"] (NoArg Version) "Show version information" + , Option "f" ["font"] (ReqArg Font "font name") "The font name" + , Option "B" ["bgcolor"] (ReqArg BgColor "bg color" ) + "The background color. Default black" + , Option "F" ["fgcolor"] (ReqArg FgColor "fg color") + "The foreground color. Default grey" + , Option "o" ["top"] (NoArg T) "Place xmobar at the top of the screen" + , Option "b" ["bottom"] (NoArg B) + "Place xmobar at the bottom of the screen" + , Option "a" ["alignsep"] (ReqArg AlignSep "alignsep") + "Separators for left, center and right text\nalignment. Default: '}{'" + , Option "s" ["sepchar"] (ReqArg SepChar "char") + ("The character used to separate commands in" ++ + "\nthe output template. Default '%'") + , Option "t" ["template"] (ReqArg Template "template") + "The output template" + , Option "c" ["commands"] (ReqArg Commands "commands") + "The list of commands to be executed" + , Option "C" ["add-command"] (ReqArg AddCommand "command") + "Add to the list of commands to be executed" + , Option "x" ["screen"] (ReqArg OnScr "screen") + "On which X screen number to start" ] getOpts :: [String] -> IO ([Opts], [String]) @@ -134,49 +145,50 @@ getOpts argv = (_,_,errs) -> error (concat errs ++ usage) usage :: String -usage = (usageInfo header options) ++ footer +usage = usageInfo header options ++ footer where header = "Usage: xmobar [OPTION...] [FILE]\nOptions:" footer = "\nMail bug reports and suggestions to " ++ mail ++ "\n" info :: String info = "xmobar " ++ showVersion version ++ "\n (C) 2007 - 2010 Andrea Rossato " - ++ "\n (C) 2010 - 2011 Jose A Ortega Ruiz\n " + ++ "\n (C) 2010 - 2013 Jose A Ortega Ruiz\n " ++ mail ++ "\n" ++ license mail :: String mail = "<xmobar@projects.haskell.org>" license :: String -license = "\nThis program is distributed in the hope that it will be useful,\n" ++ - "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" ++ - "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" ++ - "See the License for more details." +license = "\nThis program is distributed in the hope that it will be useful," ++ + "\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" ++ + "\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." ++ + "\nSee the License for more details." doOpts :: Config -> [Opts] -> IO Config doOpts conf [] = return conf doOpts conf (o:oo) = - case o of - Help -> putStr usage >> exitWith ExitSuccess - Version -> putStrLn info >> exitWith ExitSuccess - Font s -> doOpts (conf {font = s }) oo - BgColor s -> doOpts (conf {bgColor = s }) oo - FgColor s -> doOpts (conf {fgColor = s }) oo - T -> doOpts (conf {position = Top }) oo - B -> doOpts (conf {position = Bottom}) oo - AlignSep s -> doOpts (conf {alignSep = s }) oo - SepChar s -> doOpts (conf {sepChar = s }) oo - Template s -> doOpts (conf {template = s }) oo - OnScr n -> doOpts (conf {position = OnScreen (read n) $ position conf}) oo - Commands s -> case readCom 'c' s of - Right x -> doOpts (conf { commands = x }) oo - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) - AddCommand s -> case readCom 'C' s of - Right x -> doOpts (conf { commands = commands conf ++ x }) oo - Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) - where readCom c str = - case readStr str of - [x] -> Right x - _ -> Left ("xmobar: cannot read list of commands specified with the -" ++ c:" option\n") - readStr str = - [x | (x,t) <- reads str, ("","") <- lex t] + case o of + Help -> putStr usage >> exitSuccess + Version -> putStrLn info >> exitSuccess + Font s -> doOpts' (conf {font = s}) + BgColor s -> doOpts' (conf {bgColor = s}) + FgColor s -> doOpts' (conf {fgColor = s}) + T -> doOpts' (conf {position = Top}) + B -> doOpts' (conf {position = Bottom}) + AlignSep s -> doOpts' (conf {alignSep = s}) + SepChar s -> doOpts' (conf {sepChar = s}) + Template s -> doOpts' (conf {template = s}) + OnScr n -> doOpts' (conf {position = OnScreen (read n) $ position conf}) + Commands s -> case readCom 'c' s of + Right x -> doOpts' (conf {commands = x}) + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + AddCommand s -> case readCom 'C' s of + Right x -> doOpts' (conf {commands = commands conf ++ x}) + Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) + where readCom c str = + case readStr str of + [x] -> Right x + _ -> Left ("xmobar: cannot read list of commands " ++ + "specified with the -" ++ c:" option\n") + readStr str = [x | (x,t) <- reads str, ("","") <- lex t] + doOpts' opts = doOpts opts oo |