summaryrefslogtreecommitdiffhomepage
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs112
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 06:37:08 +0000