diff options
Diffstat (limited to 'src')
| -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 | 
